home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / old / misc / prime / primek.plp < prev   
Text File  |  2020-01-01  |  139KB  |  4,171 lines
  1. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2. /*KERMIT.COMP.COMI*/
  3. /*           KERMIT.COMP.COMI
  4. /*
  5. /*  This command input file compiles the Kermit-R19 source code.
  6. /*
  7. /*  It must be run in a ufd that contains the source modules under a
  8. /*  subufd named SOURCE, and include files under subufds named INCLUDE
  9. /*  and PROCS. It puts the object code (.BIN files) under a ufd named OBJ.
  10. /*
  11. COMO KERMIT.COMP.COMO
  12. PLP *>SOURCE>MAIN.PLP -B *>OBJ>MAIN.BIN
  13. PLP *>SOURCE>COMND.PLP -B *>OBJ>COMND.BIN
  14. PLP *>SOURCE>TYPE.PLP -B *>OBJ>TYPE.BIN
  15. PLP *>SOURCE>A2B.PLP -B *>OBJ>A2B.BIN
  16. PLP *>SOURCE>B2A.PLP -B *>OBJ>B2A.BIN
  17. PLP *>SOURCE>BFR_EMPTY.PLP -B *>OBJ>BFR_EMPTY.BIN
  18. PLP *>SOURCE>BFR_FILL.PLP -B *>OBJ>BFR_FILL.BIN
  19. PLP *>SOURCE>CHAR.PLP -B *>OBJ>CHAR.BIN
  20. PLP *>SOURCE>CHR$.PLP -B *>OBJ>CHR$.BIN
  21. PLP *>SOURCE>CTL.PLP -B *>OBJ>CTL.BIN
  22. PLP *>SOURCE>MSG_INIT.PLP -B *>OBJ>MSG_INIT.BIN
  23. PLP *>SOURCE>PRS_SEND_INIT.PLP -B *>OBJ>PRS_SEND_INIT.BIN
  24. PLP *>SOURCE>REC_DATA.PLP -B *>OBJ>REC_DATA.BIN
  25. PLP *>SOURCE>REC_FILE.PLP -B *>OBJ>REC_FILE.BIN
  26. PLP *>SOURCE>REC_INIT.PLP -B *>OBJ>REC_INIT.BIN
  27. PLP *>SOURCE>REC_MESSAGE.PLP -B *>OBJ>REC_MESSAGE.BIN
  28. PLP *>SOURCE>REC_PACKET.PLP -B *>OBJ>REC_PACKET.BIN
  29. PLP *>SOURCE>REC_WORKER_SWITCH.PLP -B *>OBJ>REC_WORKER_SWITCH.BIN
  30. PLP *>SOURCE>SEND_BREAK.PLP -B *>OBJ>SEND_BREAK.BIN
  31. PLP *>SOURCE>SEND_DATA.PLP -B *>OBJ>SEND_DATA.BIN
  32. PLP *>SOURCE>SEND_EOF.PLP -B *>OBJ>SEND_EOF.BIN
  33. PLP *>SOURCE>SEND_FILE.PLP -B *>OBJ>SEND_FILE.BIN
  34. PLP *>SOURCE>SEND_INIT.PLP -B *>OBJ>SEND_INIT.BIN
  35. PLP *>SOURCE>SEND_PACKET.PLP -B *>OBJ>SEND_PACKET.BIN
  36. PLP *>SOURCE>SEND_SWITCH.PLP -B *>OBJ>SEND_SWITCH.BIN
  37. PLP *>SOURCE>SERVER.PLP -B *>OBJ>SERVER.BIN
  38. PLP *>SOURCE>SET_SEND_INIT.PLP -B *>OBJ>SET_SEND_INIT.BIN
  39. PLP *>SOURCE>UNCHAR.PLP -B *>OBJ>UNCHAR.BIN
  40. PLP *>SOURCE>CHKS.PLP -B *>OBJ>CHKS.BIN
  41. PLP *>SOURCE>FILE_INIT.PLP -B *>OBJ>FILE_INIT.BIN
  42. PLP *>SOURCE>LN$PAR.PLP -B *>OBJ>LN$PAR.BIN
  43. PLP *>SOURCE>FILE_CLOSE.PLP -B *>OBJ>FILE_CLOSE.BIN
  44. PLP *>SOURCE>FILE_OPEN.PLP -B *>OBJ>FILE_OPEN.BIN
  45. PLP *>SOURCE>NEXT_FILE.PLP -B *>OBJ>NEXT_FILE.BIN
  46. PLP *>SOURCE>BK_HNDLR.PLP -B *>OBJ>BK_HNDLR.BIN
  47. PLP *>SOURCE>TIMEOUT_HNDLR.PLP -B *>OBJ>TIMEOUT_HNDLR.BIN
  48. PMA *>SOURCE>CHAR_OCT -B *>OBJ>CHAR_OCT.BIN -L NO
  49. PMA *>SOURCE>MOD_64 -B *>OBJ>MOD_64.BIN -L NO
  50. PMA *>SOURCE>SHIFT -B *>OBJ>SHIFT.BIN -L NO
  51. PMA *>SOURCE>WILD$_DYNT -B *>OBJ>WILD$_DYNT.BIN -L NO
  52. PMA *>SOURCE>LIMIT$_DYNT -B *>OBJ>LIMIT$_DYNT.BIN -L NO
  53. FTN *>SOURCE>KERTRN -B *>OBJ>KERTRN.BIN -64V
  54. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  55. /*KERMIT.BUILD.COMI*/
  56. /*                KERMIT.BUILD.COMI
  57. /*
  58. /*  This command input file will link the Kermit-R19 object code, to
  59. /*  create a KERMIT.SEG file.
  60. /*
  61. /*  A subufd named OBJ must exist that contains all of the object code
  62. /*  modules (.BIN files).
  63. /*
  64. /*  To compile the source code in preparation, use KERMIT.COMP.COMI.
  65. COMO KERMIT.BUILD.COMO
  66. SEG
  67. VL KERMIT.SEG
  68. LO *>OBJ>MAIN
  69. LO *>OBJ>COMND
  70. LO *>OBJ>CHAR_OCT
  71. LO *>OBJ>MOD_64
  72. LO *>OBJ>SHIFT
  73. LO *>OBJ>TYPE
  74. LO *>OBJ>A2B
  75. LO *>OBJ>B2A
  76. LO *>OBJ>BFR_EMPTY
  77. LO *>OBJ>BFR_FILL
  78. LO *>OBJ>CHAR
  79. LO *>OBJ>CHR$
  80. LO *>OBJ>CTL
  81. LO *>OBJ>KERTRN
  82. LO *>OBJ>MSG_INIT
  83. LO *>OBJ>PRS_SEND_INIT
  84. LO *>OBJ>REC_DATA
  85. LO *>OBJ>REC_FILE
  86. LO *>OBJ>REC_INIT
  87. LO *>OBJ>REC_MESSAGE
  88. LO *>OBJ>REC_PACKET
  89. LO *>OBJ>REC_WORKER_SWITCH
  90. LO *>OBJ>SEND_BREAK
  91. LO *>OBJ>SEND_DATA
  92. LO *>OBJ>SEND_EOF
  93. LO *>OBJ>SEND_FILE
  94. LO *>OBJ>SEND_INIT
  95. LO *>OBJ>SEND_PACKET
  96. LO *>OBJ>CHKS
  97. LO *>OBJ>SEND_SWITCH
  98. LO *>OBJ>SERVER
  99. LO *>OBJ>SET_SEND_INIT
  100. LO *>OBJ>UNCHAR
  101. LO *>OBJ>FILE_INIT
  102. LO *>OBJ>LN$PAR
  103. LO *>OBJ>FILE_CLOSE
  104. LO *>OBJ>FILE_OPEN
  105. LO *>OBJ>NEXT_FILE
  106. LO *>OBJ>LIMIT$_DYNT
  107. LO *>OBJ>WILD$_DYNT
  108. LO *>OBJ>BK_HNDLR
  109. LO *>OBJ>TIMEOUT_HNDLR
  110. LI VAPPLB
  111. LI
  112. MAP KERMIT.MAP
  113. SAVE
  114. Q
  115. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  116. /*KERMIT.TREE.CREATE.CPL*/
  117. /*              KERMIT.TREE.CREATE.CPL
  118. /*
  119. /*  CPL program to transform a "flat" ufd containing Kermit code
  120. /*  into a structured ufd, ready to have the code compiled.
  121. /*
  122. /*  This program is to be run in a ufd containing all the files
  123. /*  taken from the Kermit-R19 magnetic tape.
  124. /*
  125. /*  It creates sub-ufds named:
  126. /*
  127. /*        SOURCE    INCLUDE   PROCS   OBJ
  128. /*
  129. /*  It copies files from the home ufd to the subufd under which
  130. /*  they belong, deleting the original.
  131. /*
  132. /*  Some files will be left in the home ufd, namely
  133. /*
  134. /*       #READ_ME
  135. /*       KERMIT.COMP.COMI
  136. /*       KERMIT.BUILD.COMI
  137. /*       KERMIT.TREE.CREATE.CPL
  138. /*       KERMIT.TREE.REV18.CPL
  139. /*
  140. /*  After this program has run, invoke KERMIT.COMP.COMI to compile
  141. /*  all source code, and then KERMIT.BUILD.COMI to link together the
  142. /*  Kermit-R19 program.
  143. /*
  144. /*       Good Luck!
  145.  
  146. CREATE SOURCE
  147. &S UNIT := 0
  148. &DO F &ITEMS [WILD SOURCE#@@ -FILES -SINGLE UNIT]
  149. &S G := [AFTER %F% 'SOURCE#']
  150. COPY %F% *>SOURCE>%G% -RPT -DL -NQ
  151. &END
  152.  
  153. CREATE PROCS
  154. &S UNIT := 0
  155. &DO F &ITEMS [WILD PROCS#@@ -FILES -SINGLE UNIT]
  156. &S G := [AFTER %F% 'PROCS#']
  157. COPY %F% *>PROCS>%G% -RPT -DL -NQ
  158. &END
  159.  
  160. CREATE INCLUDE
  161. &S UNIT := 0
  162. &DO F &ITEMS [WILD INCLUDE#@@ -FILES -SINGLE UNIT]
  163. &S G := [AFTER %F% 'INCLUDE#']
  164. COPY %F% *>INCLUDE>%G% -RPT -DL -NQ
  165. &END
  166.  
  167. CREATE OBJ
  168. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  169. /*KERMIT.TREE.REV18.CPL*/
  170. /*              KERMIT.TREE.REV18.CPL
  171. /*
  172. /*  CPL program to transform a "flat" ufd containing Kermit code
  173. /*  into a structured ufd, ready to have the code compiled.
  174. /*
  175. /*  This program is to be run in a ufd containing all the files
  176. /*  taken from the Kermit-R19 magnetic tape.
  177. /*
  178. /*  It creates sub-ufds named:
  179. /*
  180. /*        SOURCE    INCLUDE   PROCS   OBJ
  181. /*
  182. /*  It copies files from the home ufd to the subufd under which
  183. /*  they belong, deleting the original.
  184. /*
  185. /*  Some files will be left in the home ufd, namely
  186. /*
  187. /*       #READ_ME
  188. /*       KERMIT.COMP.COMI
  189. /*       KERMIT.BUILD.COMI
  190. /*       KERMIT.TREE.REV18.CPL
  191. /*       KERMIT.TREE.CREATE.CPL
  192. /*
  193. /*  After this program has run, invoke KERMIT.COMP.COMI to compile
  194. /*  all source code, and then KERMIT.BUILD.COMI to link together the
  195. /*  Kermit-R19 program.
  196. /*
  197. /*       Good Luck!
  198.  
  199. &DATA FUTIL
  200. CREATE SOURCE
  201. CREATE PROCS
  202. CREATE INCLUDE
  203. CREATE OBJ
  204. FROM *
  205.  
  206. TO *>SOURCE
  207. &S UNIT := 0
  208. &DO F &ITEMS [WILD SOURCE#@@ -FILES -SINGLE UNIT]
  209. &S G := [AFTER %F% 'SOURCE#']
  210. COPY %F% %G%
  211. DELETE %F%
  212. &END
  213.  
  214. TO *>PROCS
  215. &S UNIT := 0
  216. &DO F &ITEMS [WILD PROCS#@@ -FILES -SINGLE UNIT]
  217. &S G := [AFTER %F% 'PROCS#']
  218. COPY %F% %G%
  219. DELETE %F%
  220. &END
  221.  
  222. TO *>INCLUDE
  223. &S UNIT := 0
  224. &DO F &ITEMS [WILD INCLUDE#@@ -FILES -SINGLE UNIT]
  225. &S G := [AFTER %F% 'INCLUDE#']
  226. COPY %F% %G%
  227. DELETE %F%
  228. &END
  229.  
  230. QUIT
  231. &END
  232. &RETURN
  233. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  234. /*KERMIT.DOC*/
  235. 1Contents                                                     i
  236. -
  237.  CONTENTS
  238. +CONTENTS
  239. -
  240. 0Transferring files between the Prime and your PC  . . . . .  1
  241. +Transferring files between the Prime and your PC             1
  242. 01     Running Kermit on the Prime . . . . . . . . . . . . .  1
  243.        2     File Naming Conventions . . . . . . . . . . . .  3
  244.        3     Default Kermit-R19 SET Parameters . . . . . . .  3
  245.  4     Kermit Commands Available for the Prime . . . . . . .  3
  246.        5     SERVER Command  . . . . . . . . . . . . . . . .  3
  247.        6     INIT Command  . . . . . . . . . . . . . . . . .  4
  248.        7     PORTFILE Routine  . . . . . . . . . . . . . . .  4
  249.        8     Sample Session  . . . . . . . . . . . . . . . .  5
  250. 1ii
  251. 1Contents                                                     1
  252. -
  253.  TRANSFERRING FILES BETWEEN THE PRIME AND YOUR PC
  254. +TRANSFERRING FILES BETWEEN THE PRIME AND YOUR PC
  255. -
  256. -
  257. 0Normally, when you use your PC, you are "talking" directly to
  258.  it; your commands are interpreted directly by the operating
  259.  system or by some program, such as an editor, a text
  260.  formatter, or SPSS/PC.  Kermit is a means for connecting two
  261.  computers through their terminal (TTY) ports, tricking one
  262.  computer (or both) into acting as though the other is a
  263.  terminal.  Once two computers are connected in this way,
  264.  cooperating programs can be run on each computer to achieve
  265.  the desired communications by means of a communication
  266.  protocol.
  267. 0    Kermit embodies a set of rules for transferring files
  268.  reliably between computers.  In general, one computer is a
  269.  large system (the mainframe Prime acts as a host, and contains
  270.  many terminals) and the other is a personal computer (PC).
  271.  The host believes that the PC is an ordinary terminal.  In
  272.  order for the Kermit protocol to occur, a Kermit program must
  273.  be running on each end of the communication line--one on the
  274.  Prime as host, one on the PC.
  275. 0    This documentation supplements the documentation in
  276.  SPSS/PC.  You should read that documentation first.
  277. +_______
  278. 0    Tranfer of SPSS portable system files requires the use of
  279.  the PORTFILE command described below.
  280. -1  Running Kermit on the Prime
  281. +1  Running Kermit on the Prime
  282. 0The Prime version of Kermit was developed under Prime REV19
  283.  and issues the prompt KERMIT-R19>.  It has run successfully
  284.  under REV18, also.  Kermit-R19 does not accept any
  285.  abbreviations for commands; you must type command names in
  286.  full.  It does not give guide words or respond to ? with
  287.  information on what may be done next.  Kermit-R19 does not
  288.  accept tree names.  It searches for and places files in the
  289.  currently attached directory.  If you want to send or receive
  290.  files from another directory, exit from Kermit, attach to the
  291.  desired UFD, and restart Kermit-R19.
  292. 0    Kermit lets you use your PC as a remote Prime terminal,
  293.  where you issue PRIMOS commands; as a "dumb" terminal which
  294.  accepts Kermit-R19 and Kermit-PC commands; and as a regular
  295.  PC.  You can always verify which operating system or Kermit
  296.  you are at by typing a carriage return and examining the
  297.  prompt.  The PRIMOS prompt does not appear when you transfer
  298.  from the PC to PRIMOS.
  299. 12
  300. -
  301.   1  First you start Kermit on the PC by typing
  302. + 1
  303. 0            KERMIT
  304. 0    Once you have activated PC Kermit, use the STATUS command
  305.      to make sure that parity is set to "MARK," the back-arrow
  306.      is set to "backspace," and that the baud rate is correct
  307.      for the modem.  If these parameters have to be changed,
  308.      use the Kermit-PC SET command.
  309. 0 2  Dial the number required to activate a port on the
  310. + 2
  311.      mainframe Prime.  Connect the link by typing "C" (for
  312.      CONNECT) on the PC.  Now the PC is functioning like a
  313.      remote terminal.
  314. 0 3  Login normally to the Prime.  You may have to hit the
  315. + 3
  316.      carriage return a couple of times to get "LOGIN PLEASE"
  317.      message.
  318. 0 4  Check to make sure your kill character is a non-printing
  319. + 4
  320.      character.  (On the Prime, the kill character indicates a
  321.      line delete.)  You must change the default kill character
  322.      from a question mark (?)  to some non-printing character
  323.      (such as CTRL-X), so that Kermit does not interpret it as
  324.      a signal to erase the line.
  325. 0 5  Attach to the directory in which you want to send or
  326. + 5
  327.      receive files.  If you are sending SPSS portable files,
  328.      they must be processed with PORTFILE prior to sending them
  329.      to the PC.
  330. 0 6  Start-up Prime Kermit.  At some sites this is done with
  331. + 6
  332.      the command
  333. 0           KERMIT
  334. 0    Check with your local systems staff to see how this is
  335.      done at your site.
  336. 0 7  Set up the Prime Kermit environment and perform file
  337. + 7
  338.      transfers using the commands listed in the PC Kermit
  339.      Documentation or use the SERVER command described below.
  340. 0 8  If you have sent SPSS portable files from the PC to the
  341. + 8
  342.      Prime, be sure to run them through PORTFILE prior to
  343.      reading them with the SPSS-X IMPORT command.  PORTFILE is
  344.      run on Prime Kermit.
  345. 0 9  Exit from Prime Kermit.
  346. + 9
  347. 010  LOGOUT from Prime.
  348. +10
  349. 011  Exit from PC Kermit
  350. +11
  351. 1Contents                                                     3
  352. -
  353.  2  File Naming Conventions
  354. +2  File Naming Conventions
  355. 0Kermit makes every attempt to retain the names of transferred
  356.  files.  The file naming conventions on the PC allow filenames
  357.  of eight characters followed by a three character extension.
  358.  PRIMOS uses filenames of up to 32 characters, including
  359.  suffixes.  When you send files "down" to the PC or "up" to the
  360.  Prime, some file names or extensions may be truncated if the
  361.  names are too long or changed by Kermit to prevent filename
  362.  conflicts and conform to naming conventions.  Check your
  363.  directory or UFD to see if any names have changed.
  364. -3  Default Kermit-R19 SET Parameters
  365. +3  Default Kermit-R19 SET Parameters
  366. 0The default SET parameters for Kermit-R19 (shown with the SHOW
  367.  ALL command) are
  368. 0            Delay (seconds) before sending 1st packet........     5
  369.              File Type to send/receive........................ASCII
  370.              Number pad chars to send.........................     0
  371.              Pad character to send............................200 (octal)
  372.              Quote character to receive.......................'#'
  373.              8-bit Quoting character desired (good
  374.              only if the file type is BINARY).................'N'
  375. 0These parameters can be changed using the SET command,
  376.  described in the SPSS/PC Kermit documentation.  You do not
  377.  have to make any changes to transfer portable files.  Portable
  378.  files must be sent as ASCII files.
  379. 0    The Kermit-PC STATUS command lists other available
  380.  options, including the baud rate and parity settings.
  381. -4  Kermit Commands Available for the Prime
  382. +4  Kermit Commands Available for the Prime
  383. 0Kermit on the Prime always issues the prompt, KERMIT-R19>.  In
  384.  response to this prompt, you can issue commands which give
  385.  help, show current parameter settings, and transfer files.
  386.  These commands are described in the SPSS/PC Kermit
  387.  Documentation.
  388. 0    The Prime implementation of Kermit supports the use of the
  389.  SERVER command and allows you to set parameters from an
  390.  external file with the INIT command.
  391. -5  SERVER Command
  392. +5  SERVER Command
  393. 0The SERVER command saves you from moving back and forth
  394.  between Kermit-PC and Kermit-R19.  Once you have established
  395.  the connection between your PC and the Prime, you type SERVER
  396.  at Kermit-R19, reconnect to Kermit-PC and then issue commands
  397.  that transfer files.
  398. 14
  399. -
  400.   1  Follow steps 1 through 7 above.
  401. + 1
  402. 0 2  Issue the SERVER command by typing SERVER.
  403. + 2
  404. 0 3  Reconnect to Kermit-PC by typing CTRL-] c
  405. + 3
  406. 0 4  Issue commands recognized by the server described below.
  407. + 4
  408. 0The available commands for the SERVER are
  409. 0SEND     transfers files from the current PC directory to the
  410. +SEND
  411.           currently attached Prime directory.  SEND takes a
  412.           filename as the argument or you can send groups of
  413.           files using the PC wildcard conventions.
  414. 0RECEIVE  transfers files from the currently attached Prime
  415. +RECEIVE
  416.           directory to the current PC directory.  RECEIVE takes
  417.           a filename as the argument or you can receive groups
  418.           of files using Prime wildcard conventions.
  419. 0FINISH   exits from Kermit-R19 and returns control to PRIMOS.
  420. +FINISH
  421.           You should re-connect to the Prime and perform
  422.           additional operations or LOGOUT.
  423. 0BYE      (alias LOGOUT) exits from Kermit-R19 and LOGOUT from
  424. +BYE
  425.           Prime.
  426. -6  INIT Command
  427. +6  INIT Command
  428. 0The INIT command uses a file containing SET parameters to
  429.  establish the Kermit environment.  You build this file on the
  430.  Prime using an editor.  The file serves a command input (COMI)
  431.  file.  The INIT command is used at the Kermit-R19 level and
  432.  executes the SET commands contained in the file.  The INIT
  433.  command takes the following form
  434. 0            INIT filename
  435. 0The file contains commands that are available for Kermit-R19.
  436.  After establishing the Kermit-R19 environment with SET
  437.  commands, you can issue PORTFILE (with the appropriate
  438.  responses), SHOW, or HELP commands.  If you issue the SERVER,
  439.  SEND or RECEIVE command, it must be the last command in the
  440.  INIT file.  The first SERVER, SEND, or RECEIVE command
  441.  encountered is executed and expects a response from Kermit-PC.
  442. -7  PORTFILE Routine
  443. +7  PORTFILE Routine
  444. 0The PORTFILE routine run within Kermit-R19 is used to
  445.  translate characters contained in SPSS portable files
  446.  transferred by Kermit between your PC and the Prime.  The
  447.  current portable file configuration forces Kermit to replace
  448.  some characters which are not interpreted by IMPORT and
  449. 1Contents                                                     5
  450. -
  451.  EXPORT.  The PORTFILE routine takes care of any problematic
  452.  characters.  PORTFILE is run on the Prime prior to sending a
  453.  portable file to the PC or after receiving a portable file
  454.  from the PC.  You must not run data or command files through
  455.  the PORTFILE routine.
  456. 0    PORTFILE is an interactive routine which prompts you for
  457.  the type of file, the name of the input file, and a name for
  458.  the translated file.  PORTFILE queries you until it has all
  459.  the information it needs to perform the translation.  If one
  460.  of the file names already exists, PORTFILE asks if you want to
  461.  overwrite the file.  You cannot use the same name for the
  462.  input file and the converted version.  A run to translate a
  463.  portable file received from the PC looks like
  464. 0            Are you converting a file to send to a PC?  NO
  465.              Are you converting a file received from a PC? YES
  466.              Name of file to convert: almanac.ker
  467.              Name for converted file: almanac.kermxfil
  468.              File already exists. Do you wish to overwrite? NO
  469.              Name for converted file: almanac.kxfil
  470. 0The file is then converted and both files appear in the
  471.  current Prime directory.
  472. -8  Sample Session
  473. +8  Sample Session
  474. 0In this sample session, a portable file is being sent from the
  475.  PC to the Prime using the SERVER command and then translating
  476.  the file using the PORTFILE command.  Assume that steps one
  477.  through six have been followed and that the Kermit-R19
  478.  environment has been established.
  479. 0    At Kermit-R19 level, type
  480. 0            SERVER
  481. 0To return to Kermit-PC, type
  482. 0            CTRL-] C
  483. 0Now you issue one of the commands available with the server to
  484.  send or receive files.  To send the portable file, type
  485. 0            SEND ALMANAC.KER
  486. 0You do not have to receive the file.  The SERVER operates at
  487.  the Kermit-R19 level and receives the file.  You can send
  488.  groups of files using PC-DOS wildcard conventions.  To exit
  489.  from the SERVER, type
  490. 0            FINISH
  491. 16
  492. -
  493.  The FINISH command exits from Kermit-R19.  To reconnect to
  494.  PRIMOS, type
  495. 0            C
  496. 0Now your PC is acting as a terminal connected to the Prime.
  497.  Since a portable file has been sent, the Kermit-R19 PORTFILE
  498.  routine must be executed.  To enter Kermit-R19, type
  499. 0            KERMIT
  500. 0To get to the translation routine, type
  501. 0            PORTFILE
  502. 0The PORTFILE routine asks questions about the type of
  503.  conversion, the name of the input file, and the name of the
  504.  output file.  You must answer each question.
  505. 0            Are you converting a file to send to a PC?  n
  506.              Are you converting a file received from a PC? y
  507.              Name of file to convert: almanac.ker
  508.              Name for converted file: almanac.kxfil
  509. 0When you use SPSS-X IMPORT commmand, the converted file,
  510.  almanac.kxfil, is used.
  511. 0To leave Kermit-R19, type
  512. 0            EXIT
  513. 0You can continue to use your PC as a remote terminal to the
  514.  Prime or logout by typing
  515. 0            LOGOUT
  516. 0To return to Kermit-PC, type
  517. 0            CTRL-] C
  518. 0To exit from Kermit-PC and return control to DOS, type
  519. 0            EXIT
  520. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  521. /*INCLUDE#KERCOM.REQ*/
  522. %nolist;
  523. /****************************************************
  524.  * FACILITY:
  525.  *   KERMIT-R19
  526.  *
  527.  * ABSTRACT:
  528.  *       This file contains the common definitions for KERMIT-R19.
  529.  *
  530.  * ENVIRONMENT:
  531.  *   User mode
  532.  *
  533.  * AUTHOR: Timothy P. Sabin, The SOURCE Telecomputing
  534.  * CREATION DATE: 08-July-1983
  535.  *
  536.  * MODIFIED BY:
  537.  *
  538. ****************************************************/
  539.  
  540. /*
  541.  * EQUATED SYMBOLS:
  542.  *
  543.  * Function types passed to FILE_OPEN routine.
  544.  */
  545. %replace
  546.     FNC_READ by 0,                           /* Open for reading */
  547.     FNC_WRITE by 1;                          /* Open for writing */
  548. /*
  549.  * File types used
  550.  */
  551. %replace
  552.     FILE_ASC by 1,                           /* ASCII files (SEVEN-BIT) */
  553.     FILE_BIN by 2;                           /* Binary files */
  554. /*
  555.  * Character definitions
  556.  */
  557. %replace
  558.     CHR_NUL by '80'B4,             /* Null (tape feed character, fill charac */
  559.     CHR_SOH by '81'B4,             /* Start of header */
  560.     CHR_STX by '82'B4,             /* Start of text */
  561.     CHR_ETX by '83'B4,             /* End of text */
  562.     CHR_EOT by '84'B4,             /* End of transmission */
  563.     CHR_ENQ by '85'B4,             /* Enquiry (WRU "Who are you?") */
  564.     CHR_ACK by '86'B4,             /* Acknowledge */
  565.     CHR_BEL by '87'B4,             /* Bell */
  566.     CHR_BS by '88'B4,              /* Backspace */
  567.     CHR_TAB by '89'B4,             /* Horizontal tab */
  568.     CHR_LFD by '8A'B4,             /* Line feed */
  569.     CHR_VTB by '8B'B4,             /* Vertical tab */
  570.     CHR_FFD by '8C'B4,             /* Form feed */
  571.     CHR_CRT by '8D'B4,             /* Carriage return */
  572.     CHR_SO by '8E'B4,              /* Shift out */
  573.     CHR_SI by '8F'B4,              /* Shift in */
  574.     CHR_DLE by '90'B4,             /* Data link escape */
  575.     CHR_DC1 by '91'B4,             /* Device control 1 (also XON) */
  576.     CHR_DC2 by '92'B4,             /* Device control 2 (also TAPE or AUX ON) */
  577.     CHR_DC3 by '93'B4,             /* Device control 3 (also XOFF) */
  578.     CHR_DC4 by '94'B4,             /* Device control 4 (also AUX OFF) */
  579.     CHR_NAK by '95'B4,             /* Negative acknowledge */
  580.     CHR_SYN by '96'B4,             /* Synchronous idle (SYNC) */
  581.     CHR_ETB by '97'B4,             /* End of transmission block */
  582.     CHR_CAN by '98'B4,             /* Cancel */
  583.     CHR_EM by '99'B4,              /* End of medium */
  584.     CHR_SUB by '9A'B4,             /* Substitute */
  585.     CHR_ESC by '9B'B4,             /* Escape */
  586.     CHR_FS by '9C'B4,              /* File separator */
  587.     CHR_GS by '9D'B4,              /* Group separator */
  588.     CHR_RS by '9E'B4,              /* Record separator */
  589.     CHR_US by '9F'B4,              /* Unit separator */
  590.  
  591.     CHR_CTL_A by '81'B4,                   /* Control-A */
  592.     CHR_CTL_B by '82'B4,                   /* Control-B */
  593.     CHR_CTL_C by '83'B4,                   /* Control-C */
  594.     CHR_CTL_D by '84'B4,                   /* Control-D */
  595.     CHR_CTL_E by '85'B4,                   /* Control-E */
  596.     CHR_CTL_F by '86'B4,                   /* Control-F */
  597.     CHR_CTL_G by '87'B4,                   /* Control-G */
  598.     CHR_CTL_H by '88'B4,                   /* Control-H */
  599.     CHR_CTL_I by '89'B4,                   /* Control-I */
  600.     CHR_CTL_J by '8A'B4,                   /* Control-J */
  601.     CHR_CTL_K by '8B'B4,                   /* Control-K */
  602.     CHR_CTL_L by '8C'B4,                   /* Control-L */
  603.     CHR_CTL_M by '8D'B4,                   /* Control-M */
  604.     CHR_CTL_N by '8E'B4,                   /* Control-N */
  605.     CHR_CTL_O by '8F'B4,                   /* Control-O */
  606.     CHR_CTL_P by '90'B4,                   /* Control-P */
  607.     CHR_CTL_Q by '91'B4,                   /* Control-Q */
  608.     CHR_CTL_R by '92'B4,                   /* Control-R */
  609.     CHR_CTL_S by '93'B4,                   /* Control-S */
  610.     CHR_CTL_T by '94'B4,                   /* Control-T */
  611.     CHR_CTL_U by '95'B4,                   /* Control-U */
  612.     CHR_CTL_V by '96'B4,                   /* Control-V */
  613.     CHR_CTL_W by '97'B4,                   /* Control-W */
  614.     CHR_CTL_X by '98'B4,                   /* Control-X */
  615.     CHR_CTL_Y by '99'B4,                   /* Control-Y */
  616.     CHR_CTL_Z by '9A'B4,                   /* Control-Z */
  617.     CHR_DEL by 'FF'B4,                     /* Delete */
  618.     CHR_ESCAPE by '9D'B4;                  /* Connect escape character */
  619. /*
  620.  * Constants
  621.  */
  622. %replace
  623.     TRUE by 1,                               /* Value of true */
  624.     FALSE by 0,                              /* Value of FALSE. */
  625.     INIT_DELAY by 5,                         /* Initial delay time */
  626.     MAX_RETRIES by 30,                       /* Maximum number of retries */
  627.     MAX_MSG by 96;                           /* Maximum message length */
  628.  
  629. /*    KEY FOR THE CHECK ROUTINES    */
  630. % REPLACE
  631.      CHECK_SERVER BY 1,
  632.      CHECK_INIT BY 2,
  633.      CHECK_FILE BY 3,
  634.      CHECK_DATA BY 4;
  635. declare tnou entry (char (*),fixed);
  636. declare tnoua entry (char (*),fixed);
  637. declare todec entry (fixed);
  638. %list;
  639. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  640. /*INCLUDE#KERERR.REQ*/
  641. %nolist;
  642. %replace
  643. /*
  644.  * GENERAL MESSAGES AND ERRORS
  645.  */
  646.         KER_NORMAL by                    0,
  647.         KER_INTERNALERR by               1,
  648. /*
  649.  * FILE PROCESSING ERROR MESSAGES AND WARNINGS.
  650.  */
  651.         KER_EOF by                       2,
  652.         KER_NOMORFILES by                3,
  653.         KER_ILLFILTYP by                 4,
  654. /*
  655.  * MESSAGE LEVEL PROCESSING ERROR MESSAGES AND WARNINGS.
  656.  */
  657.         KER_EXIT by                      5,
  658.         KER_UNIMPLGEN by                 6,
  659.         KER_PROTOERR by                  7,
  660. /*
  661.  * TERMINAL LEVEL PROCESSING MESSAGES
  662.  */
  663.         KER_TIMEOUT by                   8;
  664. %list;
  665. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  666. /*INCLUDE#KERFIL_EQUS.PLP*/
  667. /*
  668.  * EQUATED SYMBOLS:
  669.  *
  670.  * Various states for reading the data from the file
  671.  */
  672. %replace
  673.     F_STATE_PRE by 0,                /* Prefix state */
  674.     F_STATE_PRE1 by 1,               /* Other prefix state */
  675.     F_STATE_DATA by 2,               /* Data processing state */
  676.     F_STATE_POST by 3,               /* Postfix processing state */
  677.     F_STATE_POST1 by 4,              /* Secondary postfix processing state */
  678.     F_STATE_MIN by 0,                /* Min state number */
  679.     F_STATE_MAX by 4;                /* Max state number */
  680. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  681. /*INCLUDE#KERFIL_GLOBAL.PLP*/
  682. /*
  683.  * Global storage:
  684.  */
  685. declare
  686.     FILE_TYPE fixed bin external;               /* Type of file being xfered */
  687. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  688. /*INCLUDE#KERFIL_LOCAL.PLP*/
  689. /*
  690.  * OWN STORAGE:
  691.  */
  692. declare
  693.     UNIT    fixed bin external;         /* File unit being used */
  694. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  695. /*INCLUDE#KERMIT_LOCAL.PLP*/
  696. %nolist;
  697. /* KERMIT Local storage */
  698.  
  699. declare
  700.         show_type    fixed bin external;     /* Type of SHOW subcommand */
  701. %list;
  702. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  703. /*INCLUDE#KERMSG_GLOBAL.PLP*/
  704. %nolist;
  705. declare
  706. /*
  707.  * Receive parameters
  708.  */
  709.     RCV_PKT_SIZE       fixed bin external,        /* Receive packet size */
  710.     RCV_NPAD           fixed bin external,        /* Padding length */
  711.     RCV_PADCHAR        char(1) aligned external,  /* Padding character */
  712.     RCV_TIMEOUT        fixed bin external,        /* Time out */
  713.     RCV_EOL            char(1) aligned external,  /* EOL character */
  714.     RCV_QUOTE_CHR      char(1) aligned external,  /* Quote character */
  715.     RCV_8QUOTE_CHR     char(1) aligned external,  /* 8-bit quoting character */
  716. /*
  717.  * Send parameters
  718.  */
  719.     SND_PKT_SIZE       fixed bin external,        /* Send packet size */
  720.     SND_NPAD           fixed bin external,        /* Padding length */
  721.     SND_PADCHAR        char(1) aligned external,  /* Padding character */
  722.     SND_TIMEOUT        fixed bin external,        /* Time out */
  723.     SND_EOL            char(1) aligned external,  /* EOL character */
  724.     SND_QUOTE_CHR      char(1) aligned external,  /* Quote character */
  725.     SND_8QUOTE_CHR     char(1) aligned external,  /* 8-bit quoting character */
  726. /*
  727.  * Misc constants
  728.  */
  729.     FILE_NAME          char(64) var external,
  730.     DELAY              fixed bin external;        /* Amount of time to delay */
  731.  
  732. %list;
  733. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  734. /*INCLUDE#KERMSG_LOCAL.PLP*/
  735. %nolist;
  736. /*
  737.  * LOCAL OWN STORAGE:
  738.  */
  739. declare
  740.     STATE          fixed bin external,       /* Current state */
  741.     OLD_RETRIES    fixed bin external,       /* Saved number of retries done */
  742.     NUM_RETRIES    fixed bin external,       /* Number of retries */
  743.     MSG_NUMBER     fixed bin external,       /* Current message number */
  744.     REC_SEQ        fixed bin external,       /* Sequence number of msg  */
  745.     REC_LENGTH     fixed bin external,       /* Length of the message recv'd */
  746.     REC_TYPE       char(1) aligned external, /* Type of the message received */
  747.     REC_MSG        char(MAX_MSG) var external,   /* Message received */
  748.     SND_MSG        char(MAX_MSG) var external,   /* Message sent */
  749.     int_buffer     char(260) external,           /* Intermediate file buffer */
  750.     int_buf_ptr    fixed bin external,      /* Pointer into int_buffer */
  751.     OPEN_FLAG      bit(1) aligned external, /* File is opened */
  752.     matches(50)    char(32) var external;   /* Multiple File (send) List */
  753. %list;
  754. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  755. /*INCLUDE#MSG_TYPES.PLP*/
  756. %nolist;
  757. /**************************************************
  758.  * The MESSAGE-DEPENDENT information field of the message contains at
  759.  * least one part  That is the type of message  The remainder of the message
  760.  * MESSAGE-DEPENDENT field is different depending on the message
  761.  *
  762.  * <TYPE><TYPE-DEPENDENT-INFORMATION>
  763.  *
  764.  * <TYPE>
  765.  *       The type defines the type of message that is being processed
  766.  *
  767. *****************************************************/
  768.  
  769. /* Protocol version 10 message types */
  770.  
  771. %replace
  772.     MSG_DATA by 'D',                           /* Data packet */
  773.     MSG_ACK by 'Y',                            /* Acknowledgement */
  774.     MSG_NAK by 'N',                            /* Negative acknowledgement */
  775.     MSG_SND_INIT by 'S',                       /* Send initiate */
  776.     MSG_BREAK by 'B',                          /* Break transmission */
  777.     MSG_FILE by 'F',                           /* File header */
  778.     MSG_EOF by 'Z',                            /* End of file (EOF) */
  779.     MSG_ERROR by 'E';                          /* Error */
  780.  
  781. /* Protocol version 20 message types */
  782.  
  783. %replace
  784.     MSG_RCV_INIT by 'R',                       /* Receive initiate */
  785.     MSG_COMMAND by 'C',                        /* Host command */
  786.     MSG_TEXT by 'X',                           /* Plain Text */
  787.     MSG_KERMIT by 'G';                         /* Generic KERMIT command */
  788.  
  789. /**************************************************
  790.  * Generic KERMIT commands
  791. *****************************************************/
  792.  
  793. %replace
  794.     MSG_GEN_LOGIN by 'I',                      /* Login */
  795.     MSG_GEN_EXIT by 'F',                       /* Finish (exit to OS) */
  796.     MSG_GEN_CONNECT by 'C',                    /* Connect to a directory */
  797.     MSG_GEN_LOGOUT by 'L',                     /* Logout */
  798.     MSG_GEN_DIRECTORY by 'D',                  /* Directory */
  799.     MSG_GEN_DISK_USAGE by 'U',                 /* Disk usage */
  800.     MSG_GEN_DELETE by 'E',                     /* Delete a file */
  801.     MSG_GEN_TYPE by 'T',                       /* Type a file specification */
  802.     MSG_GEN_SUBMIT by 'S',                     /* Submit */
  803.     MSG_GEN_PRINT by 'P',                      /* Print */
  804.     MSG_GEN_WHO by 'W',                        /* Who's logged in */
  805.     MSG_GEN_SEND by 'M',                       /* Send a message to a user */
  806.     MSG_GEN_HELP by 'H',                       /* Help */
  807.     MSG_GEN_QUERY by 'Q';                      /* Query status */
  808. %list;
  809. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  810. /*INCLUDE#PACKET_DEFS.PLP*/
  811. %nolist;
  812. /**************************************************
  813.  * The following define the various offsets of the standard KERMIT
  814.  * packets
  815. *****************************************************/
  816.  
  817. %replace
  818.     PKT_COUNT by 2,                      /* <CHAR(Count)> */
  819.     PKT_SEQ by 3,                        /* <CHAR(Seq)> */
  820.     PKT_TYPE by 4,                       /* <Message type> */
  821.     PKT_MSG by 5,                        /* <MESSAGE-DEPENDENT INFORMATION */
  822.     PKT_OVR_HEAD by 3,                   /* Overhead added to data length */
  823.     PKT_TOT_OVR_HEAD by 6;               /* Total overhead of the message */
  824. %list;
  825. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  826. /*INCLUDE#SND_INIT.PLP*/
  827. %nolist;
  828. /**************************************************
  829.  *
  830.  * The following describes the send initiate packet  All fields in the message
  831.  * data area are optional
  832.  *
  833.  * <"S"><CHAR(Bufsiz)><CHAR(Timeout)><CHAR(npad)><CTL(pad)><CHAR(Eol)><Quote>
  834.  *       <8-bit-quote><Reserved><Reserved><Reserved><Reserved>
  835.  *
  836.  * BUFSIZ
  837.  *       Sending Kermit's maximum buffer size
  838.  *
  839.  * Timeout
  840.  *       Number of seconds after which the sending Kermit wishes to be timed out
  841.  *
  842.  * Npad
  843.  *       Number of padding caracters the sending Kermit needs preceding each
  844.  *       packet
  845.  *
  846.  * PAD
  847.  *       Padding character
  848.  *
  849.  * EOL
  850.  *       A line terminator required on all packets set by the receiving
  851.  *       Kermit
  852.  *
  853.  * Quote
  854.  *       The printable ASCII characer the sending Kermit will use when quoting
  855.  *       the control cahracters  Default is "#"
  856.  *
  857.  * 8-bit-quote
  858.  *       Specify quoting mecanism for 8-bit quantities  A quoting mecanism is
  859.  *       mecessary when sending to hosts which prevent the use of the 8th bit
  860.  *       for data  When elected, the quoting mechanism will be used by both
  861.  *       hosts, and the quote character must be in the range of 41-76 or 140-176
  862.  *       octal, but different from the control-quoting character  This field is
  863.  *       interpreted as follows:
  864.  *
  865.  *       "Y" - I agree to 8-bit quoting if you request it
  866.  *       "N" - I will not do 8-bit quoting
  867.  *       "&" - (or any other character in the range of 41-76 or 140-176) I want
  868.  *             to do 8-bit quoting using this character (it will be done if the
  869.  *             other Kermit puts a "Y" in this field
  870.  *       Anything else: Quoting will not be done
  871.  *
  872.  * Fields 8 to 11 reserved
  873. *****************************************************/
  874.  
  875. %replace
  876.     P_SI_BUFSIZ by 0,                        /* Buffersize */
  877.     MY_PKT_SIZE by 94,                       /* My packet size */
  878.     P_SI_TIMOUT by 1,                        /* Time out */
  879.     MY_TIME_OUT by 15,                       /* My time out */
  880.     P_SI_NPAD by 2,                          /* Number of padding characters */
  881.     MY_NPAD by 0,                            /* Amount of padding I require */
  882.     P_SI_PAD by 3,                           /* Padding character */
  883.     MY_PAD_CHAR by '80'B4,                   /* My pad character */
  884.     P_SI_EOL by 4,                           /* End of line character */
  885.     MY_EOL_CHAR by '8D'B4,                   /* My EOL cahracter */
  886.     P_SI_QUOTE by 5,                         /* Quote character */
  887.     MY_QUOTE_CHAR by '#',                    /* My quoting character */
  888.     P_SI_8QUOTE by 6,                        /* 8-bit quote */
  889.     MY_8BIT_QUOTE by 'N',                    /* Don't do it */
  890.     P_SI_LENGTH by 7;                        /* Length of the message */
  891. %list;
  892. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  893. /*INCLUDE#STATES.PLP*/
  894. %nolist;
  895. /**************************************************
  896.  * The following are the various states that KERMIT can be in
  897.  * The state transitions are defined in the KERMIT Protocol manual
  898. *****************************************************/
  899.  
  900. %replace
  901.     STATE_S by 1,                        /* Send init state */
  902.     STATE_SF by 2,                       /* Send file header */
  903.     STATE_SD by 3,                       /* Send file data packet */
  904.     STATE_SZ by 4,                       /* Send EOF packet */
  905.     STATE_SB by 5,                       /* Send break */
  906.     STATE_R by 6,                        /* Receive state (wait for send-i) */
  907.     STATE_RF by 7,                       /* Receive file header packet */
  908.     STATE_RD by 8,                       /* Receive file data packet */
  909.     STATE_X by 9,                        /* Text send init */
  910.     STATE_XF by 10,                      /* Text header */
  911.     STATE_C by 11,                       /* Send complete */
  912.     STATE_A by 12;                       /* Abort */
  913. %list;
  914. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  915. /*INCLUDE#KERMIT_EQUS.PLP*/
  916. %nolist;
  917. /*********************************************************
  918.  *
  919.  *  Equates for module KERMIT
  920.  *
  921.  ********************************************************/
  922.  
  923. /* Command EQU's: */
  924.  
  925. %replace
  926.         cmd_exit    by 2,     /* Exit command */
  927.         cmd_help    by 3,     /* Help command */
  928.         cmd_quit    by 4,     /* Quit command */
  929.         cmd_rece    by 5,     /* Receive command */
  930.         cmd_set     by 6,     /* Set command */
  931.         cmd_send    by 7,     /* Send command */
  932.         cmd_server  by 8,     /* Server command */
  933.         cmd_show    by 9,     /* Show command */
  934.         cmd_port    by 10,    /* SPSS portable file conversion */
  935.         cmd_init    by 11;    /* Initialize command */
  936.  
  937. /* SHOW subcommand EQU's: */
  938.  
  939. %replace
  940.         show_all           by 1,     /* Show all info available */
  941.         show_delay         by 2,     /* Show delay in seconds */
  942.         show_file_type     by 3,     /* Show file type */
  943.         show_npad          by 4,     /* Show number pad chars to send */
  944.         show_padchar       by 5,     /* Show padding character */
  945.         show_quote         by 6,     /* Show quote character to receive */
  946.         show_8quote        by 7;     /* Show 8-bit quote character desired */
  947. %list;
  948. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  949. /*PROCS#A2B.EXT*/
  950. declare a2b entry (char(*),fixed bin) returns(fixed bin);
  951. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  952. /*PROCS#B2A.EXT*/
  953. declare b2a entry (fixed bin) returns(char(1));
  954. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  955. /*PROCS#BFR_EMPTY.EXT*/
  956. declare bfr_empty entry (fixed) returns(fixed);
  957. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  958. /*PROCS#BFR_FILL.EXT*/
  959. declare bfr_fill entry returns(fixed bin);
  960. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  961. /*PROCS#CHAR.EXT*/
  962. declare char entry (char(*),fixed bin) returns(char(1));
  963. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  964. /*PROCS#CHR$.EXT*/
  965. declare chr$ entry ( bit(8) ) returns ( char(1) );
  966. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  967. /*PROCS#COMND.EXT*/
  968. declare comnd entry returns(fixed bin);
  969. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  970. /*PROCS#CTL.EXT*/
  971. declare ctl entry (char(*),fixed bin) returns(char(1));
  972. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  973. /*PROCS#DBG_SEND.EXT*/
  974. declare dbg_send entry (char(*) var);
  975. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  976. /*PROCS#FILE_CLOSE.EXT*/
  977. declare file_close entry (fixed bin) returns(fixed bin);
  978. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  979. /*PROCS#FILE_DUMP.EXT*/
  980. declare file_dump entry returns(fixed bin);
  981. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  982. /*PROCS#FILE_INIT.EXT*/
  983. declare file_init entry;
  984. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  985. /*PROCS#FILE_OPEN.EXT*/
  986. declare file_open entry (fixed bin) returns(bit(1));
  987. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  988. /*PROCS#KRM_ERROR.EXT*/
  989. declare krm_error entry (fixed bin);
  990. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  991. /*PROCS#MOD_64.EXT*/
  992. declare mod_64  entry (fixed bin) returns(fixed bin);
  993. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  994. /*PROCS#MSG_INIT.EXT*/
  995. declare msg_init entry;
  996. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  997. /*PROCS#NEXT_FILE.EXT*/
  998. declare next_file entry returns(fixed bin);
  999. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1000. /*PROCS#PRS_SEND_INIT.EXT*/
  1001. declare prs_send_init entry (fixed bin);
  1002. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1003. /*PROCS#PUT_FILE.EXT*/
  1004. declare put_file entry (char(1)) returns(fixed bin);
  1005. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1006. /*PROCS#REC_DATA.EXT*/
  1007. declare rec_data entry returns(fixed bin);
  1008. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1009. /*PROCS#REC_FILE.EXT*/
  1010. declare rec_file entry returns(fixed bin);
  1011. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1012. /*PROCS#REC_INIT.EXT*/
  1013. declare rec_init entry returns(fixed bin);
  1014. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1015. /*PROCS#REC_MESSAGE.EXT*/
  1016. declare rec_message entry (fixed) returns (bit(1));
  1017. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1018. /*PROCS#REC_PACKET.EXT*/
  1019. declare rec_packet entry returns(fixed bin);
  1020. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1021. /*PROCS#REC_WORKER_SWITCH.EXT*/
  1022. declare rec_worker_switch entry returns(fixed bin);
  1023. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1024. /*PROCS#SEND_BREAK.EXT*/
  1025. declare send_break entry returns(fixed bin);
  1026. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1027. /*PROCS#SEND_DATA.EXT*/
  1028. declare send_data entry returns(fixed bin);
  1029. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1030. /*PROCS#SEND_EOF.EXT*/
  1031. declare send_eof entry returns(fixed bin);
  1032. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1033. /*PROCS#SEND_FILE.EXT*/
  1034. declare send_file entry returns(fixed bin);
  1035. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1036. /*PROCS#SEND_INIT.EXT*/
  1037. declare send_init entry returns(fixed bin);
  1038. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1039. /*PROCS#SEND_PACKET.EXT*/
  1040. declare send_packet entry (char(1),fixed bin,fixed bin);
  1041. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1042. /*PROCS#SEND_SWITCH.EXT*/
  1043. declare send_switch entry (fixed bin);
  1044. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1045. /*PROCS#SERVER.EXT*/
  1046. declare server entry;
  1047. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1048. /*PROCS#SET_SEND_INIT.EXT*/
  1049. declare set_send_init entry (fixed bin);
  1050. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1051. /*PROCS#SHIFT.EXT*/
  1052. declare shift   entry (fixed bin) returns(fixed bin);
  1053. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1054. /*PROCS#TYPE.EXT*/
  1055. declare type entry (char(*) var,pointer,fixed bin) returns(fixed bin);
  1056. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1057. /*PROCS#UNCHAR.EXT*/
  1058. declare unchar entry (char(*),fixed bin) returns(char(1));
  1059. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1060. /*SOURCE#A2B.PLP*/
  1061. a2b: procedure(char_str,pos) returns(fixed bin); /* Proc to take a character
  1062.      and put in the low order byte of a fixed bin variable */
  1063.  
  1064.  
  1065. declare char_str   char(80),        /* String to get character from */
  1066.         pos        fixed bin;       /* Position of character in string */
  1067.  
  1068. declare char2      char(2),
  1069.         c_ptr      pointer,
  1070.         c_bin      fixed bin based; /* Overlay bin over char(2) variable */
  1071.  
  1072. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  1073.       correctly handle QUIT$ on-unit */
  1074. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  1075.         bk_hndlr entry (fixed bin);
  1076.  
  1077.  
  1078.   call mkonu$('QUIT$',bk_hndlr);
  1079.  
  1080.   c_ptr = addr(char2);
  1081.   c_ptr->c_bin = 0;    /* Initialize output to 0 */
  1082.   substr(char2,2,1) = substr(char_str,pos,1); /* Now get the character */
  1083.   return(c_ptr->c_bin);
  1084.  
  1085. end;
  1086. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1087. /*SOURCE#B2A.PLP*/
  1088. b2a: procedure(fixed_bin) returns(char(1));   /* Proc to turn the lower byte
  1089.                of a fixed bin variable to a single character */
  1090.  
  1091. declare fixed_bin   fixed bin,
  1092.         fb_char     char(2) based;   /* Overlays fixed_bin */
  1093.  
  1094. declare temp   char(1);    /* Returned character */
  1095.  
  1096. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  1097.       correctly handle QUIT$ on-unit */
  1098. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  1099.         bk_hndlr entry (fixed bin);
  1100.  
  1101.   call mkonu$('QUIT$',bk_hndlr);
  1102.  
  1103.   temp = substr(addr(fixed_bin)->fb_char,2,1); /* Get low order byte (char) */
  1104.   return(temp);
  1105.  
  1106. end;
  1107. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1108. /*SOURCE#BFR_EMPTY.PLP*/
  1109. bfr_empty: procedure(key) returns(fixed);
  1110.  
  1111. /* Key = 0 except if file_type is binary and this is the last time */
  1112. declare key   fixed bin;
  1113.  
  1114. /***********************************************
  1115.  * FUNCTIONAL DESCRIPTION:
  1116.  *
  1117.  *       This routine will empty the data from the REC_MSG message buffer
  1118.  *       to the file  It will process quoting characters
  1119.  *
  1120.  * CALLING SEQUENCE:
  1121.  *
  1122.  *       Flag = BFR_EMPTY(key);
  1123.  *
  1124.  * OUTPUT PARAMETERS:
  1125.  *
  1126.  *       True - No problems writing the file
  1127.  *       False - I/O error writing the file
  1128.  **************************************************/
  1129.  
  1130. $Include syscom>keys.ins.pl1
  1131. $Include syscom>errd.ins.pl1
  1132. $Include *>include>kererr.req
  1133. $Include *>include>packet_defs.plp
  1134. $Include *>include>kermsg_global.plp
  1135. $Include *>include>kercom.req
  1136. $Include *>include>kermsg_local.plp
  1137. $Include *>include>snd_init.plp
  1138. $Include *>include>kerfil_global.plp
  1139. $Include *>include>kerfil_local.plp
  1140. $Include *>include>msg_types.plp
  1141. $Include *>procs>ctl.ext
  1142. $Include *>procs>shift.ext
  1143. $Include *>procs>b2a.ext
  1144. $Include *>procs>a2b.ext
  1145. $Include *>procs>send_packet.ext
  1146.  
  1147. declare wtlin$ entry (fixed bin,char(*),fixed bin,fixed bin),
  1148.         chr$   entry (bit(8)) returns(char(1)),
  1149.         prwf$$ entry (bin,bin,pointer,bin,bin(31),bin,bin),
  1150.         mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  1151.         bk_hndlr entry (fixed bin);
  1152. /* mkonu$ and bk_hndlr added 04-24-84 by C. Devine at SPSS, Inc.
  1153.  * to handle QUIT$ condition properly */
  1154.  
  1155. declare
  1156.         nw           fixed bin,
  1157.         parity       fixed bin,  /* Parity bit determined by 8 bit quoting */
  1158.         eol_flag     fixed bin static initial(0), /* To find CR/LF sequence */
  1159.         buffer       char(256) var static initial (''),
  1160.         status       fixed bin,
  1161.         buf_fix      char(256),
  1162.         1 char_var   based,
  1163.           2 len      fixed bin,
  1164.           2 data     char(80),
  1165.         COUNTER      fixed bin,     /* Count of the characters left */
  1166.         CHARACTER    char(1);       /* Character we are processing */
  1167.  
  1168.   call mkonu$('QUIT$',bk_hndlr);
  1169.  
  1170.   if key = 0 then do; /* Indicates a normal call */
  1171.     rec_msg = substr(rec_msg,PKT_MSG,length(rec_msg) - 5);
  1172.     do counter = 1 to length(rec_msg);
  1173.       character = substr(rec_msg,counter,1);
  1174.       if file_type = FILE_BIN then do;
  1175.         parity = 0;
  1176.         if rcv_8quote_chr ^= MY_8BIT_QUOTE then do;
  1177.           if character = rcv_8quote_chr then do;
  1178.             parity = 128;
  1179.             counter = counter + 1;
  1180.             character = substr(rec_msg,counter,1);
  1181.           end;
  1182.         end;
  1183.       end;
  1184.       if character = rcv_quote_chr then do;
  1185.         counter = counter + 1;
  1186.         character = substr(rec_msg,counter,1);
  1187.         if character >= '?' then character = ctl(character,1);
  1188.       END;
  1189.       if file_type = FILE_BIN then do;
  1190.         character = b2a(a2b(character,1) - 128 + parity);
  1191.       end;
  1192.       if file_type = FILE_ASC then
  1193.         select (character);
  1194.           when (chr$(CHR_CRT)) eol_flag = 1;
  1195.           when (chr$(CHR_LFD)) eol_flag = eol_flag + 1;
  1196.           otherwise eol_flag = 0;
  1197.         end;
  1198.       if (file_type = FILE_ASC) & (eol_flag = 2) then do;
  1199.         substr(buffer,length(buffer),1) = ' ';
  1200.         nw = shift(length(buffer));
  1201.         call wtlin$(unit,addr(buffer)->char_var.data,nw,status);
  1202.         buffer = '';
  1203.         if status = E$DKFL then do;
  1204.           snd_msg = 'Disk on remote system full, transfer aborted';
  1205.           call send_packet(MSG_ERROR,length(snd_msg),msg_number);
  1206.           return(status);
  1207.         end; else if status ^= 0 then do;
  1208.           snd_msg = 'Error on remote, file transfer terminated';
  1209.           call send_packet(MSG_ERROR,length(snd_msg),msg_number);
  1210.           return(status);
  1211.         end;
  1212.       end; else buffer = buffer || character;
  1213.     END;
  1214.   end;
  1215.   if (file_type = FILE_BIN) & (length(buffer) ^= 0) then do;
  1216.     /* Only if last time, count odd */
  1217.     if key = 1 then buffer = buffer || chr$('00'B4);
  1218.     buf_fix = buffer;
  1219.     call prwf$$(K$WRIT,unit,addr(buf_fix),shift(length(buffer)),0,nw,status);
  1220.     if status = E$DKFL then do;
  1221.       snd_msg = 'Disk on remote system full, transfer aborted';
  1222.       call send_packet(MSG_ERROR,length(snd_msg),msg_number);
  1223.       return(status);
  1224.     end; else if status ^= 0 then do;
  1225.       snd_msg = 'Error on remote, file transfer terminated';
  1226.       call send_packet(MSG_ERROR,length(snd_msg),msg_number);
  1227.       return(status);
  1228.     end;
  1229.     if (length(buffer) & '00001'B3) ^= 0
  1230.         then buffer = substr(buffer,length(buffer),1);
  1231.     else buffer = '';
  1232.   end;
  1233.   RETURN(KER_NORMAL);
  1234.  
  1235. END;                           /* End of BFR_EMPTY */
  1236. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1237. /*SOURCE#BFR_FILL.PLP*/
  1238. bfr_fill: procedure returns(fixed bin);
  1239. /***********************************************
  1240.  * FUNCTIONAL DESCRIPTION:
  1241.  *
  1242.  *       This routine will fill the buffer with data from the file  It
  1243.  *       will do all the quoting that is required
  1244.  *
  1245.  * CALLING SEQUENCE:
  1246.  *
  1247.  *       EOF_FLAG = BFR_FILL();
  1248.  *
  1249.  * OUTPUT PARAMETERS:
  1250.  *
  1251.  *       True - Buffer filled may be at end of file
  1252.  *       False - At end of file
  1253.  *
  1254.  * IMPLICIT OUTPUTS:
  1255.  *
  1256.  *       Number of characters stored in the buffer
  1257. **************************************************/
  1258.  
  1259. $Include syscom>keys.ins.pl1
  1260. $Include syscom>errd.ins.pl1
  1261. $Include *>include>kercom.req
  1262. $Include *>include>kerfil_global.plp
  1263. $Include *>include>kerfil_local.plp
  1264. $Include *>include>kererr.req
  1265. $Include *>include>packet_defs.plp
  1266. $Include *>include>kermsg_global.plp
  1267. $Include *>include>kermsg_local.plp
  1268. $Include *>include>msg_types.plp
  1269. $Include *>procs>a2b.ext
  1270. $Include *>procs>b2a.ext
  1271. $Include *>procs>ctl.ext
  1272. $Include *>procs>send_packet.ext
  1273.  
  1274. declare chr$   entry (bit(8)) returns(char(1)),
  1275.         rdlin$ entry (fixed bin,char(*),fixed bin,fixed bin),
  1276.         prwf$$ entry (bin,bin,pointer,bin,bin(31),bin,bin),
  1277.         nlen$a entry (char(*),fixed bin) returns(fixed bin),
  1278.         mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  1279.         bk_hndlr entry (fixed bin);
  1280. /* mkonu$ and bk_hndlr added 04-24-84 by C. Devine at SPSS, Inc.
  1281.  * to handle QUIT$ condition properly */
  1282.  
  1283. declare
  1284.         char_bin     fixed bin,
  1285.         size         fixed bin static,
  1286.         CHARACTER    char(1),          /* Character read from the file */
  1287.         code         fixed bin,        /* Status from disk routines */
  1288.         char_len     fixed bin static, /* Character length of int_buffer */
  1289.         rnw          fixed bin;        /* Number of words read (prwf$$) */
  1290.  
  1291.   call mkonu$('QUIT$',bk_hndlr);
  1292.  
  1293.   snd_msg = '';     /* Clear sending buffer */
  1294. loop:
  1295.   do size = 1 to (snd_pkt_size - PKT_TOT_OVR_HEAD - 2);
  1296.     if int_buf_ptr = 1 then do;
  1297.       if file_type = FILE_ASC then do;
  1298.         call rdlin$(unit,int_buffer,128,code);
  1299.         char_len = nlen$a(int_buffer,256);
  1300.       end; else if file_type = FILE_BIN then do;
  1301.         call prwf$$(K$READ,unit,addr(int_buffer),128,0,rnw,code);
  1302.         char_len = rnw * 2;
  1303.         if char_len ^= 0 then code = 0;
  1304.       end; else return(KER_ILLFILTYP);
  1305.       if(code = E$EOF) & (size = 1) then return(KER_EOF);
  1306.     end; else code = 0;
  1307.     character = substr(int_buffer,int_buf_ptr,1);
  1308.     if int_buf_ptr <= char_len then int_buf_ptr = int_buf_ptr + 1;
  1309.     else if code ^= 0 then leave loop;
  1310.     else int_buf_ptr = 1;
  1311. /*
  1312.  * Determine if this is a character that must be quoted
  1313.  */
  1314.     if int_buf_ptr ^= 1 then do;
  1315.       char_bin = a2b(character,1);
  1316.       if (file_type = FILE_ASC) & (char_bin >= 128) then
  1317.         char_bin = char_bin - 128;
  1318.       if (snd_8quote_chr ^= 'N') & (char_bin >= 128) then do;
  1319.         snd_msg = snd_msg || snd_8quote_chr;
  1320.         size = size + 1;
  1321.         char_bin = char_bin - 128;
  1322.       end;
  1323.       char_bin = char_bin + 128;
  1324.       character = b2a(char_bin);
  1325.       if (char_bin < 160)           /* 160 is ASCII space with parity on */
  1326.               | (character = chr$(CHR_DEL))
  1327.               | (character = SND_QUOTE_CHR)
  1328.               | ((character = snd_8quote_chr) & (snd_8quote_chr ^= 'N'))
  1329.     then do;
  1330.         snd_msg = snd_msg || snd_quote_chr;
  1331.         size = size + 1;
  1332.         if (character ^= SND_QUOTE_CHR) & (character ^= snd_8quote_chr)
  1333.             then character = ctl(character,1);
  1334.       end;
  1335. /*
  1336.  * Now write the character into the buffer
  1337.  */
  1338.       snd_msg = snd_msg || character;
  1339.     end; else do;
  1340.       if file_type = FILE_ASC then do;
  1341.         if (size - 3) < snd_pkt_size then do;
  1342.           snd_msg = snd_msg || snd_quote_chr || 'M' || snd_quote_chr || 'J';
  1343.           size = size + 3;
  1344.         end; else do;
  1345.           int_buf_ptr = 2;        /* Make a buffer with <CR><LF> only. */
  1346.           char_len = 3;
  1347.           int_buffer = ' ' || chr$(CHR_CRT) || chr$(CHR_LFD);
  1348.           leave loop;
  1349.         end;
  1350.       end;
  1351.     end;
  1352.   END;
  1353.   if (code ^= 0) & (code ^= E$EOF) then do;
  1354.     snd_msg = 'Error on remote, file transfer terminated';
  1355.     call send_packet(MSG_ERROR,length(snd_msg),msg_number);
  1356.     return(KER_INTERNALERR);
  1357.   end;
  1358.   return(KER_NORMAL);
  1359.  
  1360. END;                                        /* End of BFR_FILL */
  1361. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1362. /*SOURCE#BK_HNDLR.PLP*/
  1363. bk_hndlr: procedure(point);   /* Handle QUIT condition for KERMIT */
  1364. /* set_time_limit added by C. Devine at SPSS, Inc. to turn off
  1365.      timeout in case of break.  Also added tnou call */
  1366.  
  1367. declare point         fixed bin;
  1368. $Include syscom>keys.ins.pl1
  1369. $Include *>include>kermsg_global.plp
  1370. $Include *>include>kerfil_local.plp
  1371.  
  1372. declare my_duplex     bit(16) aligned external initial('0000'B4);
  1373.  
  1374. declare duplx$   entry (bit(16)),
  1375.         srch$$   entry (fixed,char(*),fixed,fixed,fixed,fixed),
  1376.         tnou     entry (char(*),fixed),
  1377.         exit     entry;
  1378.  
  1379. declare 1 char_var    based,
  1380.           2 len       fixed bin,
  1381.           2 data      char(128),
  1382.         type          fixed bin,
  1383.         code          fixed bin;
  1384.  
  1385.   if my_duplex ^= 0 then do;
  1386.     call duplx$(my_duplex);
  1387.     call srch$$(K$CLOS,addr(file_name)->char_var.data,length(file_name),
  1388.                 unit,type,code);
  1389.   end;
  1390.   call set_time_limit(0);
  1391.   call tnou('Exiting from Kermit-R19',23);
  1392.   call exit;
  1393.  
  1394. /**************************************************************************/
  1395.  
  1396. /*
  1397.  *    SET_TIME_LIMIT sets the real time watchdog timer.
  1398.  *    The ALARM$ condition will be raised after <mins> minutes.
  1399.  */
  1400. set_time_limit: proc( mins );
  1401.      dcl mins fixed bin(31);
  1402.      dcl code fixed bin;
  1403.      dcl limit$ entry( bin, bin(31), bin, bin ) external;
  1404.      call limit$( '0602'b4, mins, 0, code );
  1405. end;
  1406.  
  1407. end;
  1408. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1409. /*SOURCE#CHAR.PLP*/
  1410. char: procedure(char_str,pos) returns(char(1));  /* Make character printable */
  1411.  
  1412. declare char_str   char(80),
  1413.         pos        fixed bin;   /* Character position w/in char_str */
  1414.  
  1415. declare fixed_bin  fixed bin,   /* To do arithmetic on character */
  1416.         c2         char(2) based,  /* Overlays fixed_bin */
  1417.         c1         char(1);     /* Return value */
  1418.  
  1419. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  1420.       correctly handle QUIT$ on-unit */
  1421. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  1422.         bk_hndlr entry (fixed bin);
  1423.  
  1424.  
  1425.   call mkonu$('QUIT$',bk_hndlr);
  1426.  
  1427.   fixed_bin = 0;    /* Init so things turn out as expected */
  1428.   substr(addr(fixed_bin)->c2,2,1) = substr(char_str,pos,1); /* Xfer input
  1429.       to low order byte of fixed_bin */
  1430.   fixed_bin = fixed_bin + 32;  /* Turn on "printable" bit */
  1431.   c1 = substr(addr(fixed_bin)->c2,2,1);
  1432.   return(c1);
  1433.  
  1434. end;
  1435. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1436. /*SOURCE#CHAR_OCT.PMA*/
  1437. *      CHAR_OCT.PMA, KERMIT>SOURCE, T. SABIN, SOURCE, 08/05/83
  1438. *      TYPE OUT CHAR(1) IN OCTAL
  1439. *
  1440. *      OUTPUT OCTAL NUMBER
  1441. *
  1442. *
  1443. *
  1444.        SUBR   CH_OCT,ECB
  1445. *
  1446.        SEG
  1447.        RLIT
  1448. *
  1449. CH_OCT  ARGT                  XFER ARG PTR
  1450.        LDA     ARG1,*        GET WORD
  1451.        LRL    1
  1452.        IAB
  1453.        LDX    M3             =-3
  1454. TOOL   CAR                   GET DIGIT,
  1455.        LLR    3
  1456.        ADD    AZERO          CONVERT TO ASCII,
  1457.        CALL   T1OB           AND OUTPUT.
  1458.        IRX
  1459.        JMP    TOOL
  1460.        PRTN                  RETURN
  1461. *
  1462. *      DATA
  1463. *
  1464. M3     DEC     -3
  1465. AZERO  OCT     260           ='0'
  1466. *
  1467.        FIN
  1468. *
  1469. *
  1470.        DYNM    ARG1(3)
  1471. *
  1472.        LINK
  1473. ECB    ECB     CH_OCT,,ARG1,1
  1474. *
  1475.        END
  1476. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1477. /*SOURCE#CHKS.PLP*/
  1478. /*
  1479.  *       CHKS -- Subroutine to compute Kermit checksum
  1480.  */
  1481.  
  1482. chks: proc( c ) returns( bin );
  1483.  
  1484. dcl c char(96) var,    /* Char string to be processed (input) */
  1485.     tot fixed bin,     /* Sum of char values of c */
  1486.  
  1487.     topbyte bit(1) aligned,  /* Flag indicating high order byte of word */
  1488.     i fixed bin,       /* Word index into char string */
  1489.     ci fixed bin;      /* Loop counter */
  1490.  
  1491.     /* Bit configuration for computing tot from char string */
  1492. dcl 1 a(50) based,
  1493.       2 a1skip bit(1),
  1494.       2 a1 bit(7),
  1495.       2 a2skip bit(1),
  1496.       2 a2 bit(7);
  1497.  
  1498.     /* Bit configuration for computing checksum from tot value */
  1499. dcl 1 s based,
  1500.       2 s1 bit(8),
  1501.       2 s2 bit(2),
  1502.       2 s3 bit(6);
  1503.  
  1504. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  1505.       correctly handle QUIT$ on-unit */
  1506. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  1507.         bk_hndlr entry (fixed bin);
  1508.  
  1509.   call mkonu$('QUIT$',bk_hndlr);
  1510.  
  1511. topbyte = '0'b;  /* Skip first char (mark), so take low order byte */
  1512. i = 2;           /* Word index into char var string (skip first word) */
  1513. tot = 0;           /* Initialize total count */
  1514.  
  1515. /* Loop once for each character in the string */
  1516. do ci = 2 to length(c);
  1517.  
  1518.     if topbyte then do;
  1519.        i = i + 1;
  1520.        tot = tot + addr(c)->a1(i);
  1521.     end;
  1522.  
  1523.     else do;
  1524.        tot = tot + addr(c)->a2(i);
  1525.     end;
  1526.  
  1527.     topbyte = ^topbyte;
  1528. end;
  1529.  
  1530. /* Compute checksum from total of character values */
  1531. /* (Add bits 6-7 to bits 0-5 then return 6-bit value) */
  1532.  
  1533. tot = tot + addr(tot)->s2;
  1534. tot = addr(tot)->s3;
  1535.  
  1536. return( tot );
  1537.  
  1538. end; /* chks */
  1539. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1540. /*SOURCE#CHR$.PLP*/
  1541. Chr$: PROCEDURE (C) RETURNS(CHAR(1));
  1542.  
  1543. /* next 3 lines added 05-08-84 by C. Devine at SPSS, Inc. to handle
  1544.     break properly */
  1545. declare mkonu$     entry (char(32) var, entry) options(shortcall(20)),
  1546.         bk_hndlr   entry (fixed bin);
  1547.   call mkonu$('QUIT$',bk_hndlr);
  1548.  
  1549.       DCL C BIT(8) aligned;
  1550.       DCL B CHAR(1) BASED;
  1551.  
  1552.  
  1553.       RETURN (ADDR(C)->B);
  1554.  
  1555. END;
  1556. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1557. /*SOURCE#COMND.PLP*/
  1558. comnd: procedure returns(fixed bin);
  1559.  
  1560. /*************************************************************
  1561.  * FUNCTIONAL DESCRIPTION:
  1562.  *       This routine will do the command scanning for KERMIT-R19.  It
  1563.  *       will call the correct routines to process the commands.
  1564.  *
  1565.  * CALLING SEQUENCE:
  1566.  *
  1567.  *       status = comnd();
  1568.  *************************************************************/
  1569.  
  1570. $Include syscom>errd.ins.pl1
  1571. $Include *>include>kererr.req
  1572. $Include *>include>kermit_local.plp
  1573. $Include *>include>kermit_equs.plp
  1574. $Include *>include>kercom.req
  1575. $Include *>include>kermsg_global.plp
  1576. $Include *>include>kermsg_local.plp
  1577. $Include *>include>kerfil_global.plp
  1578. $Include *>include>states.plp
  1579. $Include *>procs>type.ext
  1580. $Include *>procs>server.ext
  1581. $Include *>procs>b2a.ext
  1582. $Include *>procs>send_switch.ext
  1583. $Include *>procs>rec_worker_switch.ext
  1584.  
  1585.  
  1586. declare cl$get     entry (char(*) var,fixed bin,fixed bin),
  1587.         duplx$     entry (bit(16)) returns(bit(16)),
  1588.         comi$$     entry (char(*),fixed bin,fixed bin,fixed bin),
  1589.         ln$par     entry ((100) char(32) var,fixed bin,char(*) var,fixed bin),
  1590.         tonl       entry,
  1591.         kertrn     entry,
  1592.         mkonu$     entry (char(32) var, entry) options(shortcall(20)),
  1593.         bk_hndlr   entry (fixed bin);
  1594. /* mkonu$ and bk_hndlr added 04-24-84 by C. Devine at SPSS, Inc.
  1595.  * to handle QUIT$ condition properly */
  1596.  
  1597. /***********************************************************
  1598.  *
  1599.  *The following are the command state tables for the KERMIT-R19
  1600.  *command processing.
  1601.  *
  1602.  *************************************************************/
  1603.  
  1604. %replace KERMIT_LEN    by 11;
  1605.  
  1606. declare kermit_state (KERMIT_LEN) char(26) var static initial
  1607.          ('CONNECT',
  1608.           'EXIT',
  1609.           'HELP',
  1610.           'QUIT',
  1611.           'RECEIVE',
  1612.           'SET',
  1613.           'SEND',
  1614.           'SERVER',
  1615.           'SHOW',
  1616.           'PORTFILE',
  1617.           'INIT');
  1618.  
  1619. /* Table for SET command */
  1620. %replace STATE_LEN   by 6;
  1621.  
  1622. declare set_state (STATE_LEN) char(26) var static initial
  1623.          ('DELAY',
  1624.           'FILE_TYPE',
  1625.           'NPAD',
  1626.           'PADCHAR',
  1627.           'QUOTE',
  1628.           '8-BIT-QUOTE');
  1629.  
  1630. %replace SET_DELAY          by 1,
  1631.          SET_FILE_TYPE      by 2,
  1632.          SET_NPAD           by 3,
  1633.          SET_PADCHAR        by 4,
  1634.          SET_QUOTE          by 5,
  1635.          SET_8QUOTE         by 6;
  1636.  
  1637. /* Table for SHOW command */
  1638. %replace SHOW_LEN   by 7;
  1639.  
  1640. declare show_state (SHOW_LEN) char(26) var static initial
  1641.          ('ALL',
  1642.           'DELAY',
  1643.           'FILE_TYPE',
  1644.           'NPAD',
  1645.           'PADCHAR',
  1646.           'QUOTE',
  1647.           '8-BIT-QUOTE');
  1648.  
  1649. declare
  1650.     server_text      char(80) var static initial
  1651.  ('[Kermit Server running on Prime host.  Please type your escape sequence to'),
  1652.  
  1653.     server_text_1    char(80) var static initial
  1654.  ('return to your local machine.  Shut down the server by typing the Kermit'),
  1655.  
  1656.     server_text_2    char(80) var static initial
  1657.  ('BYE command on your local machine.]'),
  1658.  
  1659.     error_text       char(80) var static initial
  1660.  ('Error: Unrecognized/Unimplemented Command'),
  1661.  
  1662.     token     (100) char(32) var static,
  1663.     1 char_var       based,
  1664.       2 len          fixed bin,
  1665.       2 data         char(80),
  1666.     command          fixed bin;
  1667.  
  1668. declare
  1669.         num_tok     fixed bin,
  1670.         CMD_BUF     char(80) var,
  1671.         my_duplex   bit(16) aligned external,
  1672.         STATUS      fixed bin;
  1673.  
  1674. declare ch_oct   entry(char(1));
  1675.  
  1676.  
  1677.  
  1678.   comnd_help: procedure;
  1679. /***************************************************************
  1680.  *
  1681.  * COMND_HELP: Display available commands
  1682.  * Calling sequence: call comnd_help;
  1683.  *
  1684.  ***************************************************************/
  1685. declare mkonu$     entry (char(32) var, entry) options(shortcall(20)),
  1686.         bk_hndlr   entry (fixed bin);
  1687.   call mkonu$('QUIT$',bk_hndlr);
  1688.  
  1689.     call tonl;
  1690.     call tonl;
  1691.     call tnou('           Kermit-R19 Available Commands',40);
  1692.     call tnou('           -----------------------------',40);
  1693.     call tonl;
  1694.     call tnou('EXIT back to operating system (PRIMOS)',38);
  1695.     call tnou('INIT: Initialize parameters thru a file',39);
  1696.     call tnou('QUIT back to operating system (PRIMOS)',38);
  1697.     call tnou('RECEIVE a file',14);
  1698.     call tnou('SEND a file',11);
  1699.     call tnou('SERVER: invoke Kermit server',28);
  1700.     call tnou('SET a parameter.  Available parameters are:',43);
  1701.     call tnou('   DELAY: Time to delay before sending',38);
  1702.     call tnou('   FILE_TYPE: Type of file to transfer (BINARY or ASCII)',56);
  1703.     call tnou('   NPAD: Number of pad characters to send',41);
  1704.     call tnou('   PADCHAR: Padding character to send (in octal)',48);
  1705.     call tnou('   QUOTE: Set the quote character to receive',44);
  1706.     call tnou('          (default is ''#'')',26);
  1707.     call tnou('   8-BIT-QUOTE: Set the 8-bit quote character you would',55);
  1708.     call tnou('                like to have ( default is ''&'')',46);
  1709.     call tnou('SHOW a parameter.  Available parameters are:',44);
  1710.     call tnou('    ALL: Show all available parameters',38);
  1711.     call tnou('    DELAY: Time to delay before sending',39);
  1712.     call tnou('    FILE_TYPE: Type of file to transfer',39);
  1713.     call tnou('    NPAD: Number of pad characters to send',42);
  1714.     call tnou('    PADCHAR: Padding character to send (in octal)',49);
  1715.     call tnou('    QUOTE: Show the quoting character to receive',48);
  1716.     call tnou('    8-BIT-QUOTE: Show the 8-bit quote character',47);
  1717.     call tnou('                 you would like to have',39);
  1718.     call tnou('PORTFILE: convert an PORTFILE portable file',43);
  1719.     call tnou('HELP: Display this help file',28);
  1720.     call tonl;
  1721.     call tonl;
  1722.     return;
  1723.  
  1724.   end;
  1725.  
  1726. /**************************************************************************/
  1727.  
  1728.   comnd_show: procedure(option);
  1729.  
  1730.   declare option   fixed bin;       /* Tells what to show */
  1731.  
  1732. declare mkonu$     entry (char(32) var, entry) options(shortcall(20)),
  1733.         bk_hndlr   entry (fixed bin);
  1734.   call mkonu$('QUIT$',bk_hndlr);
  1735.  
  1736.     select (option);
  1737.       when (SHOW_ALL) do;
  1738.         call comnd_show(SHOW_DELAY);
  1739.         call comnd_show(SHOW_FILE_TYPE);
  1740.         call comnd_show(SHOW_NPAD);
  1741.         call comnd_show(SHOW_PADCHAR);
  1742.         call comnd_show(SHOW_QUOTE);
  1743.         call comnd_show(SHOW_8QUOTE);
  1744.       end;
  1745.       when (SHOW_FILE_TYPE) do;
  1746.         call tnoua('File Type to send/receive.........................',50);
  1747.         if file_type = FILE_ASC then call tnou('ASCII',5);
  1748.         else call tnou('BINARY',6);
  1749.       end;
  1750.       when (SHOW_DELAY) do;
  1751.         call tnoua('Delay (seconds) before sending 1st packet.........',50);
  1752.         call todec(delay);
  1753.         call tonl;
  1754.       end;
  1755.       when (SHOW_NPAD) do;
  1756.         call tnoua('Number pad chars to send..........................',50);
  1757.         call todec(snd_npad);
  1758.         call tonl;
  1759.       end;
  1760.       when (SHOW_PADCHAR) do;
  1761.         call tnoua('Pad character to send.............................',50);
  1762.         call ch_oct(snd_padchar);
  1763.         call tnou(' (octal)',8);
  1764.       end;
  1765.       when (SHOW_QUOTE) do;
  1766.         call tnoua('Quote character to receive........................',50);
  1767.         call tnou(''''||rcv_quote_chr||'''',3);
  1768.       end;
  1769.       when (SHOW_8QUOTE) do;
  1770.         call tnou('8-Bit Quoting character desired (good',37);
  1771.         call tnoua('only if the file type is BINARY)..................',50);
  1772.         call tnou(''''||rcv_8quote_chr||'''',3);
  1773.       end;
  1774.       otherwise
  1775.         call tnou('Unrecognized/unimplemented SHOW command, re-enter',49);
  1776.     end;
  1777.     return;
  1778.  
  1779.   end;
  1780.  
  1781. /**************************************************************************/
  1782.  
  1783.   comnd_set: procedure;
  1784.  
  1785. $Include syscom>a$keys.ins.pl1
  1786.   declare type$a entry (fixed bin,char(*),fixed bin) returns(fixed bin),
  1787.           cnva$a entry (fixed bin,char(*),fixed bin,fixed bin(31));
  1788.  
  1789.   declare long_int    fixed bin(31);
  1790.  
  1791. declare mkonu$     entry (char(32) var, entry) options(shortcall(20)),
  1792.         bk_hndlr   entry (fixed bin);
  1793.   call mkonu$('QUIT$',bk_hndlr);
  1794.  
  1795.     command = type(token(2),addr(set_state),STATE_LEN);
  1796.  
  1797.     select (command);
  1798.  
  1799.       when (SET_FILE_TYPE) do;
  1800.         select (token(3));
  1801.           when ('ASCII') do;
  1802.             file_type = FILE_ASC;
  1803.             rcv_8quote_chr = 'N';    /* ASCII files are 7 bits, no need */
  1804.           end;
  1805.           when ('BINARY') do;
  1806.             file_type = FILE_BIN;
  1807.             rcv_8quote_chr = '&';   /* Binary files need 8-bit quoting */
  1808.           end;
  1809.           otherwise call tnou('Improper setting - ASCII or BINARY only',39);
  1810.         end;
  1811.       end;
  1812.  
  1813.       when (SET_DELAY) do;
  1814.         if type$a(A$DEC,addr(token(3))->char_var.data,length(token(3))) = FALSE
  1815.           then do;
  1816.           call tnou('SET DELAY: Non-decimal number entered',37);
  1817.           return;
  1818.         end;
  1819.         call cnva$a(A$DEC,addr(token(3))->char_var.data,length(token(3)),
  1820.                     long_int);
  1821.         delay = long_int;
  1822.       end;
  1823.  
  1824.       when (SET_NPAD) do;
  1825.         if (type$a(A$DEC,addr(token(3))->char_var.data,
  1826.                    length(token(3))) = FALSE) then do;
  1827.           call tnou('SET NPAD: Non-decimal number entered',36);
  1828.           return;
  1829.         end;
  1830.         call cnva$a(A$DEC,addr(token(3))->char_var.data,
  1831.                     length(token(3)),long_int);
  1832.         snd_npad = long_int;
  1833.       end;
  1834.  
  1835.       when (SET_PADCHAR) do;
  1836.         if (type$a(A$OCT,addr(token(3))->char_var.data,
  1837.                    length(token(3))) = FALSE) then do;
  1838.           call tnou('SET PADCHAR: Non-octal number entered',37);
  1839.           return;
  1840.         end;
  1841.         call cnva$a(A$OCT,addr(token(3))->char_var.data,
  1842.                     length(token(3)),long_int);
  1843.         if long_int > 255 then do;
  1844.           call tnou('SET PADCHAR: Character won''t fit in 8 bits',42);
  1845.           return;
  1846.         end;
  1847.         status = long_int;
  1848.         snd_padchar = b2a(status);
  1849.       end;
  1850.  
  1851.       when (SET_QUOTE) do;
  1852.         if (length(token(3)) ^= 1) | (token(3) >= '?') then do;
  1853.           call tnou(
  1854.          'SET QUOTE: A single punctuation character must be entered',57);
  1855.           return;
  1856.         end;
  1857.         rcv_quote_chr = token(3);
  1858.       end;
  1859.  
  1860.       when (SET_8QUOTE) do;
  1861.         if (length(token(3)) ^= 1) | (token(3) >= '?') then do;
  1862.           call tnou(
  1863.           'SET 8-BIT-QUOTE: A single punctuation character must be',55);
  1864.           call tnou(
  1865.           'entered, and it must be different from the quote character',58);
  1866.           return;
  1867.         end;
  1868.         rcv_8quote_chr = token(3);
  1869.       end;
  1870.  
  1871.       otherwise
  1872.         call tnou('Unrecognized/unimplemented SET command, re-enter',48);
  1873.     end;
  1874.  
  1875.   end;
  1876.  
  1877. /**************************************************************************/
  1878. /*                      MAIN COMND LOOP                                   */
  1879. /**************************************************************************/
  1880.  
  1881.   call mkonu$('QUIT$',bk_hndlr);
  1882.  
  1883.   do while (1);
  1884.  
  1885. /* Initialize some per-command data areas. */
  1886.     SHOW_TYPE = 0;
  1887.  
  1888. /* Get user command */
  1889.     do until((length(cmd_buf) ^= 0) | (status ^= 0));
  1890.       call tnoua('Kermit-R19> ',12);
  1891.       call cl$get(cmd_buf,80,status);
  1892.     end;
  1893.  
  1894.     /* Check for end of command file */
  1895.     IF status = E$EOF then return(KER_NORMAL);
  1896.  
  1897.     if status = 0 then do;
  1898.  
  1899.       call ln$par(token,num_tok,cmd_buf,status);
  1900.       if status ^= 0 then return(KER_INTERNALERR);
  1901.  
  1902.       command = type(token(1),addr(kermit_state),KERMIT_LEN);
  1903.       select(command);
  1904.  
  1905.         when (0) call tnou(addr(error_text)->char_var.data,length(error_text));
  1906.  
  1907.         when (CMD_EXIT) return(KER_NORMAL); /* Go back to PRIMOS */
  1908.  
  1909.         when (CMD_INIT) do;        /* INIT typed in */
  1910.           call comi$$(addr(token(2))->char_var.data,length(token(2)),6,status);
  1911.           if status ^= 0 then do;
  1912.             call tnou('Cannot open file '||token(2),17+length(token(2)));
  1913.           end;
  1914.         end;
  1915.  
  1916.         when (CMD_QUIT) return(KER_NORMAL); /* Go back to PRIMOS */
  1917.  
  1918.         when (CMD_HELP) call comnd_help;    /* Display HELP info */
  1919.  
  1920.         when (CMD_SERVER) do;             /* SERVER typed in */
  1921.           call tnou(addr(server_text)->char_var.data,length(server_text));
  1922.           call tnou(addr(server_text_1)->char_var.data,length(server_text_1));
  1923.           call tnou(addr(server_text_2)->char_var.data,length(server_text_2));
  1924.           call server;
  1925.           return(KER_NORMAL);
  1926.         end;
  1927.  
  1928.         when (CMD_SHOW) do;              /* SHOW typed in */
  1929.           command = type(token(2),addr(show_state),SHOW_LEN);
  1930.           call comnd_show(command);
  1931.         end;
  1932.  
  1933.         when (CMD_SET) call comnd_set;    /* SET typed in */
  1934.  
  1935.         when (CMD_SEND) do;                    /* SEND typed in */
  1936.           my_duplex = duplx$('FFFF'B4);
  1937.           status = duplx$('A000'B4);
  1938.           file_name = token(2);
  1939.           call send_switch(STATE_S);
  1940.           status = duplx$(my_duplex);
  1941.         end;
  1942.  
  1943.         when (CMD_RECE) do;                    /* RECEIVE typed in */
  1944.           my_duplex = duplx$('FFFF'B4);
  1945.           status = duplx$('A000'B4);
  1946.           state = STATE_R;
  1947.           status = rec_worker_switch();
  1948.           status = duplx$(my_duplex);
  1949.         end;
  1950.  
  1951.         when (CMD_PORT) do;
  1952.           call kertrn();
  1953.         end;
  1954.  
  1955.       end; /* select */
  1956.     end; else return(status);
  1957.  
  1958.   end; /* do while */
  1959.  
  1960. end;/* COMND */
  1961. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1962. /*SOURCE#CTL.PLP*/
  1963. /*
  1964.  * CTL: Toggle character's "ctl" bit.
  1965.  */
  1966. ctl: procedure(char_str,pos) returns(char(1));
  1967.  
  1968. declare char_str   char(80),
  1969.         pos        fixed bin;   /* Character position w/in char_str */
  1970.  
  1971. declare fixed_bin  bit(8),      /* To do arithmetic on character */
  1972.         c1         char(1) based;     /* Return value */
  1973.  
  1974.  
  1975. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  1976.       correctly handle QUIT$ on-unit */
  1977. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  1978.         bk_hndlr entry (fixed bin);
  1979.  
  1980.  
  1981.   call mkonu$('QUIT$',bk_hndlr);
  1982.  
  1983.   /* Xfer input to working storage */
  1984.   addr(fixed_bin)->c1 = substr(char_str,pos,1);
  1985.  
  1986.   /* Toggle character's "control" bit */
  1987.   if (fixed_bin & '40'B4) = 0 then
  1988.     fixed_bin = fixed_bin | '40'B4;
  1989.   else
  1990.     fixed_bin = fixed_bin & 'BF'B4;
  1991.  
  1992.   return(addr(fixed_bin)->c1);
  1993.  
  1994. end;
  1995. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  1996. /*SOURCE#FILE_CLOSE.PLP*/
  1997. FILE_CLOSE: PROCEDURE(c) returns(fixed bin);
  1998.  
  1999. declare c   fixed bin;
  2000.  
  2001. $Include syscom>keys.ins.pl1
  2002. $Include *>include>kercom.req
  2003. $Include *>include>kermsg_global.plp
  2004. $Include *>include>kermsg_local.plp
  2005. $Include *>include>msg_types.plp
  2006. $Include *>include>kerfil_local.plp
  2007. $Include *>include>kerfil_global.plp
  2008. $Include *>procs>send_packet.ext
  2009. $Include *>procs>bfr_empty.ext
  2010.  
  2011. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2012.       correctly handle QUIT$ on-unit */
  2013. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2014.         bk_hndlr entry (fixed bin);
  2015.  
  2016. declare srch$$ entry (bin,char(*),bin,bin,bin,bin),
  2017.         trnc$a entry (fixed bin);
  2018.  
  2019. declare temporary  fixed bin external;
  2020.  
  2021. declare (type,code)   fixed bin,
  2022.         1 char_var    based,
  2023.           2 len       fixed bin,
  2024.           2 data      char(80);
  2025.  
  2026.   call mkonu$('QUIT$',bk_hndlr);
  2027.  
  2028.   if (file_type = FILE_BIN) & (c = FNC_WRITE) then do;
  2029.     code = bfr_empty(1);  /* This is a last call */
  2030.     call trnc$a(unit);
  2031.   end;
  2032.  
  2033.   call srch$$(K$CLOS,addr(file_name)->char_var.data,length(file_name),
  2034.               unit,type,code);
  2035.  
  2036.   if temporary = 1 then do;
  2037.     call srch$$(K$DELE,addr(file_name)->char_var.data,length(file_name),
  2038.                 unit,type,code);
  2039.     temporary = 0;
  2040.   end;
  2041.  
  2042.   if code ^= 0 then do;
  2043.     snd_msg = 'Error on remote, file transfer terminated';
  2044.     call send_packet(MSG_ERROR,length(snd_msg),msg_number);
  2045.   end;
  2046.  
  2047.   return(code);
  2048.  
  2049. END;
  2050. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2051. /*SOURCE#FILE_INIT.PLP*/
  2052. file_init: procedure;
  2053. /********************************************************************
  2054.  * FUNCTIONAL DESCRIPTION:
  2055.  *
  2056.  *       This routine will initialize some of the storage in the file processing
  2057.  *       module.
  2058.  *******************************************************************/
  2059.  
  2060. $Include *>include>kercom.req
  2061. $Include *>include>kerfil_global.plp
  2062.  
  2063. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2064.       correctly handle QUIT$ on-unit */
  2065. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2066.         bk_hndlr entry (fixed bin);
  2067.  
  2068.  
  2069.   call mkonu$('QUIT$',bk_hndlr);
  2070.  
  2071.   FILE_TYPE = FILE_ASC;
  2072.  
  2073. END;                                        /* End of FILE_INIT */
  2074. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2075. /*SOURCE#FILE_OPEN.PLP*/
  2076. file_open: procedure(c) returns(bit(1));
  2077.  
  2078. declare c fixed bin;
  2079.  
  2080. $Include syscom>keys.ins.pl1
  2081. $Include *>include>kermsg_global.plp
  2082. $Include *>include>kercom.req
  2083. $Include *>include>kerfil_local.plp
  2084.  
  2085. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2086.       correctly handle QUIT$ on-unit */
  2087. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2088.         bk_hndlr entry (fixed bin);
  2089.  
  2090. declare srch$$    entry (bin,char(*),bin,bin,bin,bin);
  2091.  
  2092. declare keys    fixed bin,
  2093.         type    fixed bin,
  2094.         1 char_var based,
  2095.           2 len    fixed bin,
  2096.           2 data   char(80),
  2097.         code    fixed bin,
  2098.         count   fixed bin,
  2099.         lcnt    fixed bin,
  2100.         slen    fixed bin,
  2101.         orig_name char(32),
  2102.         suffix    char(4);
  2103.  
  2104.   call mkonu$('QUIT$',bk_hndlr);
  2105.  
  2106.   if c = FNC_READ then
  2107.     keys = K$READ + K$GETU;
  2108.   else if c = FNC_WRITE then do;
  2109. /*
  2110.  * setting of file write parameters rewritten by C. Devine at SPSS, Inc.
  2111.  * 11 May 84.  Now attempt to open a file under new file name if original
  2112.  * exists by adding suffix '.Knn' where nn ranges from 1 to 99.  If the
  2113.  * length of file_name is greater than 28, truncate and then add suffix.
  2114.  * If after 99 tries, can't find unused file name, reset file name to
  2115.  * original and return error  */
  2116.  
  2117.     keys = K$WRIT + K$GETU;
  2118.     orig_name = file_name;
  2119.     count = 0;
  2120.     code = 0;
  2121.     do while (code = 0);
  2122.       call srch$$(K$EXST,addr(file_name)->char_var.data,
  2123.               length(file_name),0,type,code);
  2124.       if (code = 0) then do;
  2125.         count = count + 1;
  2126.         if (count > 99) then do;
  2127.            file_name = orig_name;
  2128.            return('0'B);
  2129.         end;
  2130.         if (count < 10)
  2131.             then lcnt = 1;
  2132.             else lcnt = 2;
  2133.         suffix = '.K'||character(count,lcnt);
  2134.         slen = index(orig_name,' ');
  2135.         if ( slen = 0 | slen > 28 )
  2136.           then slen = 28;
  2137.           else slen = slen - 1;
  2138.         file_name = substr(orig_name,1,slen)||suffix;
  2139.       end;
  2140.     end;
  2141.   end;
  2142.   else
  2143.     return('0'B);
  2144.  
  2145.   call srch$$(keys,addr(file_name)->char_var.data,length(file_name),
  2146.               unit,type,code);
  2147.  
  2148.   if code = 0 then return('1'B);
  2149.   else return('0'B);
  2150.  
  2151. end;
  2152. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2153. /*SOURCE#KSEND.F77*/
  2154. C     This Fortran program should be run on the mainframe in conjunction
  2155. C     with a Basic program on the IBM PC to transfer Kermit.Fix to the PC.
  2156. C     Daphne Tzoar, January 1983
  2157. C     Columbia University Center for Computing Activities
  2158.  
  2159.       integer a(64)
  2160.  
  2161.       open(7,file='HELP**>K>KERMIT>KERMIT.FIX',STATUS='OLD')
  2162.       write(1,50)
  2163. 50    format('Ready to transfer data......')
  2164.  
  2165. C     Get terminal handshake
  2166. 100   read (1,10,end=35)x
  2167. 10    format(a1)
  2168.  
  2169. C     Get line from file
  2170. 35    read (7,20,end=90)a
  2171. 20    format(64a1)
  2172.  
  2173. C     Write to tty
  2174.       write (1,25)a
  2175. 25    format(64a1,';')
  2176.       goto 100
  2177. 90    continue
  2178.  
  2179. C     Get final handshake
  2180.       write (1,30)
  2181. 30    format(65('@'))
  2182.       return
  2183.       end
  2184. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2185. /*SOURCE#LIMIT$_DYNT.PMA*/
  2186.   SEG
  2187.   DYNT LIMIT$
  2188.   END
  2189. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2190. /*SOURCE#LN$PAR.PLP*/
  2191. /*ln$par.plp
  2192.  
  2193. This program takes a line of input and passes back an array of tokens.
  2194. It converts all to upcase.
  2195. */
  2196. /* 08/04/83 Make correction to accept final 1-character tokens. TPS */
  2197. ln$par:    proc(token,numtok,buff,code);
  2198. declare
  2199.      token (100) char (32) var,
  2200.      snap entry(char (*) , fixed bin),
  2201.       todec entry(fixed bin),
  2202. /*     tnou entry (char (*),fixed bin),*/
  2203.      numtok fixed bin,
  2204.      buff char (160) var,
  2205.      code fixed bin,
  2206.      uppercase char (27) static init ('ABCDEFGHIJKLMNOPQRSTUVWXYZ '),
  2207.      lowercase char (27) static init ('abcdefghijklmnopqrstuvwxyz,'),
  2208.      char char (1),
  2209.      (i,n,k,l) fixed bin;
  2210.  
  2211. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2212.       correctly handle QUIT$ on-unit */
  2213. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2214.         bk_hndlr entry (fixed bin);
  2215.  
  2216.   call mkonu$('QUIT$',bk_hndlr);
  2217.  
  2218. /*call tnou('in ln$par$',10);*/
  2219. buff = translate(buff,uppercase,lowercase);
  2220. /*call tnou(buff,length(buff));*/
  2221. /*call tnou('line 1',6);*/
  2222. l = 1;
  2223. n = 1;
  2224. i= 1;
  2225. buff=trim(buff,'11'b);
  2226. do  until (n > length(buff));
  2227. /*call tnou('line2 ',6);*/
  2228.           do while (substr(buff,n,1) ^=' '   & n <= length(buff));
  2229. /*call snap(n,1);*/
  2230. /*call tnou(char ,length(char));*/
  2231. /*call tnou('line 3',6);*/
  2232.          n = n + 1;
  2233.          end;
  2234. /*call tnou('line 4',6);*/
  2235. /*call snap(i,1);*/
  2236. /*call snap(l,1);*/
  2237.     token(l) = substr(buff,i,(n-i));
  2238. /*call tnou('token',5);*/
  2239. /*call tnou(token(l),length(token(l)));*/
  2240.     l = l + 1;
  2241. /*call tnou('line 5',6);*/
  2242.          do while ( substr(buff,n,1) =' '   & n <= length(buff));
  2243.          n = n + 1;
  2244.          end;
  2245.     i = n ;
  2246. if length(token(1))<=0 then i=9999;
  2247. end;
  2248. numtok = l-1;
  2249. end;
  2250. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2251. /*SOURCE#MAIN.PLP*/
  2252. main: procedure;
  2253. /***************************************************************
  2254.  * FUNCTIONAL DESCRIPTION:
  2255.  *
  2256.  *       This is the main routine for KERMIT-R19.  This routine will
  2257.  *       initialize the various parameters and then call the command
  2258.  *       scanner to process commands.
  2259.  ***********************************************************/
  2260.  
  2261. $Include *>procs>msg_init.ext
  2262. $Include *>procs>file_init.ext
  2263. $Include *>procs>comnd.ext
  2264.  
  2265. declare bk_hndlr   entry (fixed bin),
  2266.         timeout_hndlr entry( pointer ),
  2267.         mkonu$     entry (char(*) var,entry) options(shortcall(20));
  2268.  
  2269. declare status fixed bin;
  2270.  
  2271.  
  2272. /* Initialize some variables */
  2273.   call msg_init;
  2274.   call file_init;
  2275.  
  2276. /* Create on_units for break handling and line timeout handling */
  2277.   call mkonu$('QUIT$',bk_hndlr);
  2278.   call mkonu$('ALARM$',timeout_hndlr);
  2279.  
  2280. /* Main command loop */
  2281.   status =  comnd();
  2282.  
  2283. END;    /* end of routine MAIN */
  2284. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2285. /*SOURCE#MOD_64.PMA*/
  2286.         ENT     MOD_64,MODECB
  2287. *
  2288.         SEG
  2289. *
  2290. MOD_64  EQU     *
  2291.         ARGT                    ARGUMENT TRANSFER
  2292.         LDA     =63             WE'LL AND ARGUMENT WITH X'3F'
  2293.         ANA     LEN,*
  2294.         PRTN                    RETURN TO CALLER
  2295. *
  2296.         DYNM    LEN(3)
  2297. *
  2298.         LINK
  2299. *
  2300. MODECB  ECB     MOD_64,,LEN,1
  2301. *
  2302.         END
  2303. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2304. /*SOURCE#MSG_INIT.PLP*/
  2305. msg_init: procedure;
  2306. /**************************************************
  2307.  * FUNCTIONAL DESCRIPTION:
  2308.  *
  2309.  *       This routine will initialize the message processing for
  2310.  *       KERMIT-R19
  2311.  *
  2312.  * CALLING SEQUENCE:
  2313.  *
  2314.  *       MSG_INIT();
  2315. *****************************************************/
  2316.  
  2317. $Include *>include>kercom.req
  2318. $Include *>include>snd_init.plp
  2319. $Include *>include>kermsg_global.plp
  2320. $Include *>include>kermsg_local.plp
  2321.  
  2322. declare chr$ entry (bit(8)) returns(char(1));
  2323.  
  2324. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2325.       correctly handle QUIT$ on-unit */
  2326. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2327.         bk_hndlr entry (fixed bin);
  2328.  
  2329.  
  2330.   call mkonu$('QUIT$',bk_hndlr);
  2331. /*
  2332.  * Receive parameters first
  2333.  */
  2334.     RCV_PKT_SIZE = MY_PKT_SIZE;
  2335.     RCV_NPAD = MY_NPAD;
  2336.     RCV_PADCHAR = chr$(MY_PAD_CHAR);
  2337.     RCV_TIMEOUT = MY_TIME_OUT;
  2338.     RCV_EOL = chr$(MY_EOL_CHAR);
  2339.     RCV_QUOTE_CHR = MY_QUOTE_CHAR;
  2340.     RCV_8QUOTE_CHR = MY_8BIT_QUOTE;
  2341. /*
  2342.  * Send parameters
  2343.  */
  2344.     SND_PKT_SIZE = MY_PKT_SIZE;
  2345.     SND_NPAD = MY_NPAD;
  2346.     SND_PADCHAR = chr$(MY_PAD_CHAR);
  2347.     SND_TIMEOUT = MY_TIME_OUT*10;
  2348.     SND_EOL = chr$(MY_EOL_CHAR);
  2349.     SND_QUOTE_CHR = MY_QUOTE_CHAR;
  2350.     SND_8QUOTE_CHR = 'N';
  2351. /* 09 MAY 84 SND_8QUOTE_CHR CHANGED FROM & TO N BY C. DEVINE AT SPSS, INC
  2352.  *   IF OTHER KERMIT DOES NOT DO 8 BIT QUOTING, & CHARACTER IS NOT
  2353.  *   CODED PROPERLY */
  2354. /*
  2355.  * Other random parameters
  2356.  */
  2357.     DELAY = INIT_DELAY;
  2358.     OPEN_FLAG = '0'B;
  2359.     rec_seq = 0;
  2360.     msg_number = 0;
  2361.  
  2362. END;                                        /* End of MSG_INIT */
  2363. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2364. /*SOURCE#NEXT_FILE.PLP*/
  2365. NEXT_FILE: PROCEDURE returns(fixed bin);
  2366. /***********************************************************
  2367.  *
  2368.  * PROCEDURE TO FETCH THE NEXT FILE FROM A MULTIPLE FILE
  2369.  * SPECIFICATION
  2370.  *
  2371.  ************************************************************/
  2372.  
  2373. $Include *>include>kercom.req
  2374. $Include *>include>kererr.req
  2375. $Include *>include>kermsg_local.plp
  2376. $Include *>include>kermsg_global.plp
  2377. $Include *>procs>file_open.ext
  2378.  
  2379. declare i     fixed bin static initial(2);
  2380.  
  2381. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2382.       correctly handle QUIT$ on-unit */
  2383. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2384.         bk_hndlr entry (fixed bin);
  2385.  
  2386.   call mkonu$('QUIT$',bk_hndlr);
  2387.  
  2388.   file_name = matches(i);               /* Get next file name */
  2389.   if ^file_open(FNC_READ) then do;
  2390.     i = 2;                               /* Finished, reset index */
  2391.     return(KER_NOMORFILES);
  2392.   end;
  2393.   i = i + 1;                             /* Point to next file name */
  2394.   return(KER_NORMAL);
  2395.  
  2396. END;
  2397. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2398. /*SOURCE#PRS_SEND_INIT.PLP*/
  2399. prs_send_init: procedure (order);
  2400.  
  2401. declare order    fixed bin;
  2402. /***********************************************
  2403.  * FUNCTIONAL DESCRIPTION:
  2404.  *
  2405.  *       This routine will parse the SEND_INIT parameters that were sent by
  2406.  *       the remote Kermit  The items will be stored into the low segment
  2407.  *
  2408.  * CALLING SEQUENCE:
  2409.  *
  2410.  *       PRS_SEND_INIT ();
  2411.  *
  2412.  * IMPLICIT INPUTS:
  2413.  *
  2414.  *       Message stored in REC_MSG
  2415. **************************************************/
  2416.  
  2417. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2418.       correctly handle QUIT$ on-unit */
  2419. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2420.         bk_hndlr entry (fixed bin);
  2421.  
  2422. $Include *>include>packet_defs.plp
  2423. $Include *>include>snd_init.plp
  2424. $Include *>include>kermsg_global.plp
  2425. $Include *>include>kercom.req
  2426. $Include *>include>kermsg_local.plp
  2427. $Include *>include>kerfil_global.plp
  2428. $Include *>procs>a2b.ext
  2429. $Include *>procs>unchar.ext
  2430. $Include *>procs>ctl.ext
  2431.  
  2432.   declare 1 char_var   based,
  2433.             2 len      fixed bin,
  2434.             2 data     char(80);
  2435.  
  2436.   call mkonu$('QUIT$',bk_hndlr);
  2437.  
  2438.   select(length(rec_msg));
  2439.     when (P_SI_BUFSIZ + 6) go to pkt_lbl;
  2440.     when (P_SI_TIMOUT + 6) go to to_lbl;
  2441.     when (P_SI_NPAD + 6) go to np_lbl;
  2442.     when (P_SI_PAD + 6) go to pc_lbl;
  2443.     when (P_SI_EOL + 6) go to eol_lbl;
  2444.     when (P_SI_QUOTE + 6) go to qc_lbl;
  2445.     when (P_SI_8QUOTE + 6) go to ebqc_lbl;
  2446.   end;
  2447.  
  2448. ebqc_lbl:
  2449.   snd_8quote_chr = substr(rec_msg,PKT_MSG + P_SI_8QUOTE);
  2450.   select (order);
  2451.  
  2452.     when (1) do;                    /* Remote sent send init */
  2453.       if (file_type = FILE_BIN) & (snd_8quote_chr = 'Y') then do;
  2454.         snd_8quote_chr = '&';
  2455.         rcv_8quote_chr = '&';
  2456.       end; else if (file_type = FILE_BIN) & (snd_8quote_chr < '?') then
  2457.         rcv_8quote_chr = 'Y';
  2458.       else do;
  2459.         snd_8quote_chr = 'N';
  2460.         rcv_8quote_chr = 'N';
  2461.       end;
  2462.     end;
  2463.  
  2464.     when (2) do;                   /* We sent send init, this is ACK */
  2465.       if snd_8quote_chr = 'Y' then snd_8quote_chr = rcv_8quote_chr;
  2466.       else rcv_8quote_chr = 'N';
  2467.     end;
  2468.   end;
  2469.  
  2470. qc_lbl:
  2471.   snd_quote_chr = substr(rec_msg,PKT_MSG + P_SI_QUOTE);
  2472.  
  2473. eol_lbl:
  2474.   snd_eol = unchar(addr(rec_msg)->char_var.data,PKT_MSG + P_SI_EOL);
  2475.  
  2476. pc_lbl:
  2477.   snd_padchar = ctl(addr(rec_msg)->char_var.data,PKT_MSG + P_SI_PAD);
  2478.  
  2479. np_lbl:
  2480.   snd_npad = a2b(unchar(addr(rec_msg)->char_var.data,
  2481.                         PKT_MSG + P_SI_NPAD),1) - 128;
  2482.  
  2483. to_lbl:
  2484.   snd_timeout = (a2b(unchar(addr(rec_msg)->char_var.data,
  2485.                             PKT_MSG + P_SI_TIMOUT),1) - 128)*10;
  2486.  
  2487. pkt_lbl:
  2488.   snd_pkt_size = a2b(unchar(addr(rec_msg)->char_var.data,
  2489.                             PKT_MSG + P_SI_BUFSIZ),1) - 128;
  2490.  
  2491. END;                            /* End of PRS_SEND_INIT */
  2492. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2493. /*SOURCE#REC_DATA.PLP*/
  2494. rec_data: procedure returns(fixed bin);
  2495.  
  2496. /**************************************************
  2497.  * FUNCTIONAL DESCRIPTION:
  2498.  *
  2499.  * This routine will accept data messages and write them to disk
  2500.  * It will also accept MSG_FILE and MSG_EOF messages
  2501.  *
  2502.  * CALLING SEQUENCE:
  2503.  *
  2504.  *       STATE = REC_DATA();
  2505.  *
  2506.  * OUTPUT PARAMETERS:
  2507.  *
  2508.  *       New state for the finite state machine
  2509. **************************************************/
  2510.  
  2511. $Include *>include>kercom.req
  2512. $Include *>include>msg_types.plp
  2513. $Include *>include>states.plp
  2514. $Include *>include>kermsg_local.plp
  2515. $Include *>procs>rec_message.ext
  2516. $Include *>procs>mod_64.ext
  2517. $Include *>procs>send_packet.ext
  2518. $Include *>procs>bfr_empty.ext
  2519. $Include *>procs>file_close.ext
  2520.  
  2521. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2522.       correctly handle QUIT$ on-unit */
  2523. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2524.         bk_hndlr entry (fixed bin);
  2525.  
  2526.   call mkonu$('QUIT$',bk_hndlr);
  2527.  
  2528. /* Get input */
  2529.   if ^rec_message(check_data) then return(STATE_A);
  2530.  
  2531. /* Process based on message type */
  2532.   select (rec_type);
  2533.  
  2534.     when (MSG_DATA) do;
  2535.  
  2536.       /* Out of sequence messages */
  2537.       if msg_number ^= rec_seq then do;
  2538.         if old_retries > MAX_RETRIES then return(STATE_A);
  2539.         OLD_RETRIES = OLD_RETRIES + 1;
  2540.         if mod_64(msg_number - 1) = rec_seq then do;
  2541.           call send_packet(MSG_ACK,0,rec_seq);
  2542.           NUM_RETRIES = 0;
  2543.           return(state);
  2544.         end; else return(STATE_A);
  2545.       end;
  2546.  
  2547.       /* Good message. Empty buffer to file */
  2548.       if bfr_empty(0) ^= 0 then return(STATE_A);
  2549.  
  2550.       call send_packet(MSG_ACK,0,rec_seq);
  2551.       OLD_RETRIES = NUM_RETRIES;
  2552.       NUM_RETRIES = 0;
  2553.       msg_number = mod_64(msg_number + 1);
  2554.       return(STATE_RD);
  2555.     end;
  2556.  
  2557.     when (MSG_EOF) do;
  2558.       if msg_number ^= rec_seq then return(STATE_A);
  2559.       call send_packet(MSG_ACK,0,rec_seq);
  2560.       OPEN_FLAG = FALSE;
  2561.       if file_close(FNC_WRITE) ^= 0 then return(STATE_A);
  2562.       msg_number = mod_64(msg_number + 1);
  2563.       return(STATE_RF);
  2564.     end;
  2565.  
  2566.     otherwise return(STATE_A);
  2567.  
  2568.   end; /* select */
  2569.  
  2570. END;      /* End of REC_DATA */
  2571. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2572. /*SOURCE#REC_FILE.PLP*/
  2573. rec_file: procedure returns(fixed bin);
  2574. /**************************************************
  2575.  * FUNCTIONAL DESCRIPTION:
  2576.  *
  2577.  *       This routine expects to receive an MSG_FILE packet from the remote
  2578.  *       KERMIT  If the message is correct this routine will change the state
  2579.  *       to STATE_RD
  2580.  *
  2581.  *       This routine also expects MSG_SND_INIT, MSG_EOF, or MSG_BREAK
  2582.  *
  2583.  * CALLING SEQUENCE:
  2584.  *
  2585.  *       STATE = REC_FILE();
  2586.  *
  2587.  * OUTPUT PARAMETERS:
  2588.  *
  2589.  *       New state
  2590. *****************************************************/
  2591.  
  2592. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2593.       correctly handle QUIT$ on-unit */
  2594. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2595.         bk_hndlr entry (fixed bin);
  2596.  
  2597. $Include *>include>kercom.req
  2598. $Include *>include>packet_defs.plp
  2599. $Include *>include>msg_types.plp
  2600. $Include *>include>snd_init.plp
  2601. $Include *>include>states.plp
  2602. $Include *>include>kermsg_local.plp
  2603. $Include *>include>kermsg_global.plp
  2604. $Include *>procs>rec_message.ext
  2605. $Include *>procs>mod_64.ext
  2606. $Include *>procs>set_send_init.ext
  2607. $Include *>procs>send_packet.ext
  2608. $Include *>procs>file_open.ext
  2609.  
  2610.   call mkonu$('QUIT$',bk_hndlr);
  2611.  
  2612.   if ^rec_message(check_file) then return(STATE_A);
  2613.   select (rec_type);
  2614.     when (MSG_SND_INIT) do;
  2615.       if old_retries > MAX_RETRIES then return(STATE_A);
  2616.       old_retries = old_retries + 1;
  2617.       if mod_64(msg_number - 1) = rec_seq then do;
  2618.         call set_send_init(1);
  2619.         call send_packet(MSG_ACK,P_SI_LENGTH,msg_number);
  2620.         NUM_RETRIES = 0;
  2621.         return(state);
  2622.       end; else return(STATE_A);
  2623.     end;
  2624.     when (MSG_EOF) do;
  2625.       if old_retries > MAX_RETRIES then return(STATE_A);
  2626.       old_retries = old_retries + 1;
  2627.       if mod_64(msg_number - 1) = rec_seq then do;
  2628.         call send_packet(MSG_ACK,0,rec_seq);
  2629.         NUM_RETRIES = 0;
  2630.         return(state);
  2631.       end; else return(STATE_A);
  2632.     end;
  2633.     when (MSG_FILE) do;
  2634.       if msg_number ^= rec_seq then return(STATE_A);
  2635.       file_name = substr(rec_msg,PKT_MSG,length(rec_msg) - 5);;
  2636.       if file_open(FNC_WRITE) ^= '1'b then return(STATE_A);
  2637.       OPEN_FLAG = TRUE;
  2638.       call SEND_PACKET (MSG_ACK, 0, MSG_NUMBER);
  2639.       old_retries = num_retries;
  2640.       NUM_RETRIES = 0;
  2641.       msg_number = mod_64(msg_number + 1);
  2642.       return(STATE_RD);
  2643.     end;
  2644.     when (MSG_BREAK) do;
  2645.       if msg_number ^= rec_seq then return(STATE_A);
  2646.       call send_packet(MSG_ACK,0,rec_seq);
  2647.       return(STATE_C);
  2648.     end;
  2649.     otherwise return(STATE_A);
  2650.   end;
  2651.  
  2652. END;                                        /* End of REC_FILE
  2653. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2654. /*SOURCE#REC_INIT.PLP*/
  2655. rec_init: procedure returns(fixed bin);
  2656. /**************************************************
  2657.  * FUNCTIONAL DESCRIPTION:
  2658.  *
  2659.  *       This routine will process an initialization message received from
  2660.  *       the remote KERMIT
  2661.  *
  2662.  * CALLING SEQUENCE:
  2663.  *
  2664.  *       STATE = REC_INIT();
  2665.  *
  2666.  * OUTPUT PARAMETERS:
  2667.  *
  2668.  *       New machine state
  2669. *****************************************************/
  2670.  
  2671. $Include *>include>msg_types.plp
  2672. $Include *>include>snd_init.plp
  2673. $Include *>include>states.plp
  2674. $Include *>include>kercom.req
  2675. $Include *>include>kermsg_local.plp
  2676. $Include *>procs>rec_message.ext
  2677. $Include *>procs>mod_64.ext
  2678. $Include *>procs>prs_send_init.ext
  2679. $Include *>procs>set_send_init.ext
  2680. $Include *>procs>send_packet.ext
  2681.  
  2682.  
  2683. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2684.       correctly handle QUIT$ on-unit */
  2685. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2686.         bk_hndlr entry (fixed bin);
  2687.  
  2688.   call mkonu$('QUIT$',bk_hndlr);
  2689.  
  2690.   if ^rec_message(check_init) then return(STATE_A);
  2691.   MSG_NUMBER = REC_SEQ;
  2692.   call prs_send_init(1);
  2693.   call set_send_init(1);
  2694.   call send_packet(MSG_ACK,P_SI_LENGTH,msg_number);
  2695.   OLD_RETRIES = NUM_RETRIES;
  2696.   NUM_RETRIES = 0;
  2697.   msg_number = mod_64(msg_number + 1);
  2698.   return(STATE_RF);  /* Ready to receive file info */
  2699.  
  2700. END;                                        /* End of REC_INIT */
  2701. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2702. /*SOURCE#REC_MESSAGE.PLP*/
  2703. rec_message: procedure(chk_routine) returns(bit(1));
  2704.  
  2705. dcl chk_routine fixed bin;
  2706.  
  2707. /***********************************************
  2708.  * FUNCTIONAL DESCRIPTION:
  2709.  *
  2710.  *       This routine will handle the retry processing for the
  2711.  *       various messages that can be received.
  2712.  *
  2713.  * CALLING SEQUENCE:
  2714.  *
  2715.  *       status = rec_message(chk_routine);
  2716.  *
  2717.  * COMPLETION CODES:
  2718.  *
  2719.  *       '0'b - Error: max retry exceeded
  2720.  *       '1'b - Good return
  2721.  *
  2722. **************************************************/
  2723.  
  2724. $Include *>include>kercom.req
  2725. $Include *>include>kererr.req
  2726. $Include *>include>msg_types.plp
  2727. $Include *>include>kermsg_local.plp
  2728. $Include *>procs>rec_packet.ext
  2729. $Include *>procs>mod_64.ext
  2730. $Include *>procs>send_packet.ext
  2731.  
  2732. declare status fixed bin;
  2733.  
  2734. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2735.       correctly handle QUIT$ on-unit*/
  2736. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2737.         bk_hndlr entry (fixed bin);
  2738.  
  2739.   call mkonu$('QUIT$',bk_hndlr);
  2740.  
  2741. do while (1);
  2742.  
  2743.     /* Keep count of number of retries */
  2744.     if num_retries > MAX_RETRIES then return('0'B);
  2745.     num_retries = num_retries + 1;
  2746.  
  2747.     /* Get the next packet */
  2748.     status = rec_packet();
  2749.  
  2750.     if status ^= 0 then do;
  2751.         call send_packet(MSG_NAK,0,mod_64(rec_seq - 1));
  2752.     end;
  2753.  
  2754.     else do;
  2755.  
  2756.         /* Process based on chk_routine parameter */
  2757.         select(chk_routine);
  2758.  
  2759.             when(check_data) select(rec_type);
  2760.                 when(msg_data,
  2761.                      msg_eof) return( '1'b );
  2762.             end;
  2763.  
  2764.             when(check_file) select(rec_type);
  2765.                 when(msg_snd_init,
  2766.                      msg_file,
  2767.                      msg_eof,
  2768.                      msg_break) return( '1'b );
  2769.             end;
  2770.  
  2771.             when(check_server) select(rec_type);
  2772.                 when(msg_snd_init,
  2773.                      msg_kermit,
  2774.                      msg_rcv_init) return( '1'b );
  2775.             end;
  2776.  
  2777.             when(check_init) select(rec_type);
  2778.                 when(msg_snd_init) return ('1'b );
  2779.             end;
  2780.  
  2781.             otherwise return( '0'b );
  2782.         end; /* select */
  2783.  
  2784.         call send_packet( MSG_NAK, 0, rec_seq );
  2785.     end;
  2786.  
  2787. end; /* do while */
  2788.  
  2789. END;         /* End of REC_MESSAGE */
  2790. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2791. /*SOURCE#REC_PACKET.PLP*/
  2792. rec_packet: procedure returns(fixed bin);
  2793. /***********************************************
  2794.  * FUNCTIONAL DESCRIPTION:
  2795.  *
  2796.  *       This routine will do the oppoiste of SEND_PACKET  It will wait
  2797.  *       for the message to be read from the remote and then it will
  2798.  *       check the message for validity
  2799.  *
  2800.  * CALLING SEQUENCE:
  2801.  *
  2802.  *       Flag = REC_PACKET();
  2803.  *
  2804.  * IMPLICIT OUTPUTS:
  2805.  *
  2806.  *       REC_MSG - Contains the message received
  2807.  *
  2808.  * COMPLETION CODES:
  2809.  *
  2810.  *       True - Packet receive ok
  2811.  *       False - Problem occured during the receiving of the packet
  2812. **************************************************/
  2813.  
  2814. $Include *>include>kercom.req
  2815. $Include *>include>kererr.req
  2816. $Include *>include>packet_defs.plp
  2817. $Include *>include>msg_types.plp
  2818. $Include *>include>kermsg_global.plp
  2819. $Include *>include>kermsg_local.plp
  2820. $Include *>procs>a2b.ext
  2821. $Include *>procs>chr$.ext
  2822. $Include *>procs>unchar.ext
  2823. $Include *>procs>send_packet.ext
  2824.  
  2825. declare
  2826.         chks  entry (char(*) var) returns(fixed bin),
  2827.         c1in entry (bin),
  2828.         cl$get entry ( char(*) var, bin, bin ),
  2829.         mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2830.         timeout_hndlr entry( pointer ),
  2831.         bk_hndlr      entry (fixed bin);
  2832. /* bk_hndlr added 04-24-84 by C. Devine at SPSS, Inc. for QUIT$ cond. */
  2833.  
  2834. declare 1 char_var       based,
  2835.           2 len          fixed bin,
  2836.           2 data         char(80),
  2837.         alarm_cond       char(32) var,
  2838.         timeout          label external,
  2839.         on_unit_made     bit(1) aligned static init( '0'b ),
  2840.         c                fixed bin,
  2841.         ctrl_a           fixed bin static initial(129),
  2842.         ctrl_a_char      char(1) static initial(''),
  2843.         line             char(max_msg) var,
  2844.         code             fixed bin,
  2845.         chksum           fixed bin;    /* Checksum of the message */
  2846.  
  2847.   call mkonu$('QUIT$',bk_hndlr);
  2848.  
  2849. /* Put local label in external variable (for timeout condition) */
  2850. timeout = bad_return;
  2851.  
  2852. /* Set 2 minute timeout */
  2853. input:  call set_time_limit( 2 );
  2854.  
  2855. /* Scan input for CTRL-A character */
  2856. do until( c = ctrl_a );
  2857.      call c1in( c );
  2858. end;
  2859.  
  2860. /* Get rest of message */
  2861. call cl$get( line, MAX_MSG, code );
  2862. call set_time_limit( 0 );  /* Turn off watchdog */
  2863. if code ^= 0 then return(KER_TIMEOUT); /* any error */
  2864.  
  2865. rec_msg = ctrl_a_char || line;
  2866.  
  2867. /*
  2868.  * Setup msg_type and chksum (the computed checksum)
  2869.  */
  2870. rec_type = substr(rec_msg,PKT_TYPE,1);
  2871. chksum = chks(substr(rec_msg,1,length(rec_msg) - 1));
  2872. /*
  2873.  * Compare computed checksum with received checksum
  2874.  */
  2875. rec_length = a2b(unchar(addr(rec_msg)->char_var.data,PKT_COUNT),1) + 2 - 128;
  2876. if chksum ^= (a2b(unchar(addr(rec_msg)->char_var.data,rec_length),1) - 128)
  2877.     then do;
  2878.     call send_packet(MSG_NAK,0,rec_seq);
  2879.     goto input; /* retry */
  2880. end;
  2881.  
  2882. /* Setup sequence number */
  2883. rec_seq = a2b(unchar(addr(rec_msg)->char_var.data,PKT_SEQ),1) - 128;
  2884.  
  2885. /* Good return */
  2886. return(KER_NORMAL);
  2887.  
  2888. /*
  2889.  * Bad return (timeout condition raised)
  2890.  *            We come here from the timeout_hndlr on-unit.
  2891.  */
  2892. bad_return: return( KER_TIMEOUT );
  2893.  
  2894. /**************************************************************************/
  2895.  
  2896. /*
  2897.  *    SET_TIME_LIMIT sets the real time watchdog timer.
  2898.  *    The ALARM$ condition will be raised after <mins> minutes.
  2899.  */
  2900. set_time_limit: proc( mins );
  2901.      dcl mins fixed bin(31);
  2902.      dcl code fixed bin;
  2903.      dcl limit$ entry( bin, bin(31), bin, bin ) external;
  2904.      call limit$( '0602'b4, mins, 0, code );
  2905. end;
  2906.  
  2907. END;           /* End of REC_PACKET */
  2908. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2909. /*SOURCE#REC_WORKER_SWITCH.PLP*/
  2910. rec_worker_switch: procedure returns(fixed bin);
  2911. /**************************************************
  2912.  * FUNCTIONAL DESCRIPTION:
  2913.  *
  2914.  *       This is the worker routine for either REC_SWITCH or SERVER.
  2915.  *       This routine will be called with the STATE variable set to the
  2916.  *       correct state for either the SERVER or the REC_SWITCH routine
  2917.  *
  2918.  * CALLING SEQUENCE:
  2919.  *
  2920.  *       Status = REC_SWITCH_WORKER();
  2921. *****************************************************/
  2922.  
  2923. $Include *>include>kercom.req
  2924. $Include *>include>states.plp
  2925. $Include *>include>kermsg_local.plp
  2926. $Include *>procs>rec_data.ext
  2927. $Include *>procs>rec_file.ext
  2928. $Include *>procs>rec_init.ext
  2929. $Include *>procs>file_close.ext
  2930.  
  2931.  
  2932. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  2933.       correctly handle QUIT$ on-unit */
  2934. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  2935.         bk_hndlr entry (fixed bin);
  2936.  
  2937. declare return_value   fixed bin,
  2938.         status         fixed bin;
  2939.  
  2940.   call mkonu$('QUIT$',bk_hndlr);
  2941.  
  2942.   num_retries = 0;       /* Initialize the number of retries */
  2943.  
  2944.   do while (TRUE);
  2945.     select (state);
  2946. /*
  2947.  * Receiving of the data and the end of file message
  2948.  */
  2949.       when (STATE_RD) state = rec_data();
  2950. /*
  2951.  * Receiving the FILE information of the break to end the transfer of
  2952.  * one or more files
  2953.  */
  2954.       when (STATE_RF) state = rec_file();
  2955. /*
  2956.  * Initialization for the receiving of a file
  2957.  */
  2958.       when (STATE_R) state = rec_init();
  2959. /*
  2960.  * Here if we have completed the receiving of the file
  2961.  */
  2962.       when (STATE_C) return(TRUE);
  2963. /*
  2964.  * Here if we aborted the transfer or we have gotten into some random
  2965.  * state (internal KERMSG problem)
  2966.  */
  2967.       otherwise do;                /* Includes STATE_A */
  2968.         if open_flag then do;
  2969.           open_flag = '0'B;
  2970.           status = file_close(FNC_WRITE);
  2971.         end;
  2972.         return(FALSE);
  2973.       end;
  2974.     end; /* select */
  2975.  
  2976.   end;
  2977.  
  2978. end;        /* End of REC_WORKER_SWITCH */
  2979. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  2980. /*SOURCE#SEND_BREAK.PLP*/
  2981. send_break: procedure returns(fixed bin);
  2982. /**************************************************
  2983.  * FUNCTIONAL DESCRIPTION:
  2984.  *
  2985.  *       This routine will send the break (end of transmission) message
  2986.  *       to the remote KERMIT  On an ACK the state becomes STATE_C
  2987.  *
  2988.  * CALLING SEQUENCE:
  2989.  *
  2990.  *       STATE = SEND_BREAK();
  2991.  *
  2992.  * OUTPUT PARAMETERS:
  2993.  *
  2994.  *       New state for the finite state machine
  2995. *****************************************************/
  2996.  
  2997. $Include *>include>kercom.req
  2998. $Include *>include>msg_types.plp
  2999. $Include *>include>states.plp
  3000. $Include *>include>kermsg_local.plp
  3001. $Include *>procs>send_packet.ext
  3002. $Include *>procs>mod_64.ext
  3003. $Include *>procs>rec_packet.ext
  3004.  
  3005. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  3006.       correctly handle QUIT$ on-unit */
  3007. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  3008.         bk_hndlr entry (fixed bin);
  3009.  
  3010.   call mkonu$('QUIT$',bk_hndlr);
  3011.  
  3012.  
  3013. /*
  3014.  * First determine if we have exceed the number of retries that are
  3015.  * allowed to attempt to send this message
  3016.  */
  3017.   IF NUM_RETRIES > MAX_RETRIES THEN RETURN( STATE_A);
  3018. /*
  3019.  * The number of retries are not exceeded.  Increment the number and then
  3020.  * attempt to send the packet again
  3021.  */
  3022.   NUM_RETRIES = NUM_RETRIES + 1;
  3023.   call send_packet(MSG_BREAK,0,msg_number);
  3024. /*
  3025.  * Now get the responce from the remote KERMIT
  3026.  */
  3027.   IF REC_PACKET() ^= 0 THEN RETURN( STATE_A);
  3028. /*
  3029.  * Determine if the packet is good
  3030.  */
  3031.   IF ^ (REC_TYPE = MSG_ACK | REC_TYPE = MSG_NAK) THEN RETURN( STATE_A);
  3032. /*
  3033.  * If this is a NAK and the message number is not the one we just send
  3034.  * treat this like an ACK, otherwise resend the last packet
  3035.  */
  3036.   IF REC_TYPE = MSG_NAK & REC_SEQ ^= mod_64(msg_number + 1)
  3037.       then return(STATE_SF);
  3038.   IF REC_SEQ ^= MSG_NUMBER THEN RETURN( STATE);
  3039. /*
  3040.  * Here to determine if there is another file to send
  3041.  */
  3042.   NUM_RETRIES = 0;
  3043.   MSG_NUMBER = mod_64(msg_number + 1);
  3044.   RETURN( STATE_C);
  3045.  
  3046. END;
  3047. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3048. /*SOURCE#SEND_DATA.PLP*/
  3049. send_data: procedure returns(fixed bin);
  3050. /**************************************************
  3051.  * FUNCTIONAL DESCRIPTION:
  3052.  *
  3053.  *       This routine will send a data message to the remote KERMIT
  3054.  *
  3055.  * CALLING SEQUENCE:
  3056.  *
  3057.  *       STATE = SEND_DATA();
  3058.  *
  3059.  * OUTPUT PARAMETERS:
  3060.  *
  3061.  *       New state to change the finite state machine to
  3062. *****************************************************/
  3063.  
  3064. declare status   fixed bin;
  3065.  
  3066. $Include *>include>kercom.req
  3067. $Include *>include>kererr.req
  3068. $Include *>include>msg_types.plp
  3069. $Include *>include>states.plp
  3070. $Include *>include>kermsg_local.plp
  3071. $Include *>procs>send_packet.ext
  3072. $Include *>procs>mod_64.ext
  3073. $Include *>procs>rec_packet.ext
  3074. $Include *>procs>bfr_fill.ext
  3075. $Include *>procs>file_close.ext
  3076.  
  3077. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  3078.       correctly handle QUIT$ on-unit */
  3079. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  3080.         bk_hndlr entry (fixed bin);
  3081.  
  3082.   call mkonu$('QUIT$',bk_hndlr);
  3083.  
  3084. /*
  3085.  * Check to see if the number of retries have been exceeded
  3086.  */
  3087.   if num_retries > MAX_RETRIES then return(STATE_A);
  3088. /*
  3089.  * Not exceeded yet  Increment the number of retries we have attempted
  3090.  * on this message
  3091.  */
  3092.     NUM_RETRIES = NUM_RETRIES + 1;
  3093. /*
  3094.  * Send the packet
  3095.  */
  3096.   call send_packet(MSG_DATA,length(snd_msg),msg_number);
  3097. /*
  3098.  * Attempt to receive a message from the remote KERMIT
  3099.  */
  3100.   if rec_packet() ^= 0 then return(STATE_A);
  3101. /*
  3102.  * Determine if the message is a NAK and the NAK is for the message number
  3103.  * that we are current working on  If the NAK is for the next packet then
  3104.  * ignore the NAK
  3105.  */
  3106.   if (rec_type = MSG_NAK) & (rec_seq ^= mod_64(msg_number + 1))
  3107.       then return(STATE_SD);
  3108. /*
  3109.  * Make sure we have a NAK or ACK
  3110.  */
  3111.   if(rec_type = MSG_ACK) | (rec_type = MSG_NAK) then do;
  3112. /*
  3113.  * Is this for this message?
  3114.  */
  3115.     if rec_seq ^= msg_number then return(state);
  3116. /*
  3117.  * It was  Set up for sending the next data message to the remote KERMIT
  3118.  * and return
  3119.  */
  3120.     NUM_RETRIES = 0;
  3121.     msg_number = mod_64(msg_number + 1);
  3122.     status = bfr_fill();
  3123.     if status = KER_NORMAL then return(STATE_SD);
  3124.     else if status ^= KER_EOF then return(STATE_A);
  3125.     ELSE do;
  3126.       status = file_close(FNC_READ);
  3127.       OPEN_FLAG = FALSE;
  3128.       RETURN(STATE_SZ);
  3129.     END;
  3130.   end; else do;
  3131. /*
  3132.  * Not an ACK or NAK, abort
  3133.  */
  3134.     RETURN(STATE_A);
  3135.   end;
  3136. END;
  3137. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3138. /*SOURCE#SEND_EOF.PLP*/
  3139. send_eof: procedure returns(fixed bin);
  3140. /**************************************************
  3141.  * FUNCTIONAL DESCRIPTION:
  3142.  *
  3143.  *       This routine will send the end of file message to the remote
  3144.  *       KERMIT  It will then determine if there are more files to
  3145.  *       send to the remote
  3146.  *
  3147.  * CALLING SEQUENCE:
  3148.  *
  3149.  *       STATE = SEND_EOF();
  3150.  *
  3151.  * OUTPUT PARAMETERS:
  3152.  *
  3153.  *       New state to change the finite state machine to
  3154.  *
  3155.  * SIDE EFFECTS:
  3156.  *
  3157.  *       Sets up for the next file to be processed if there is one
  3158.  *
  3159. *****************************************************/
  3160.  
  3161. declare
  3162.         STATUS   fixed bin;                     /* Local status of routine */
  3163.  
  3164. $Include *>include>kercom.req
  3165. $Include *>include>kererr.req
  3166. $Include *>include>msg_types.plp
  3167. $Include *>include>states.plp
  3168. $Include *>include>kermsg_local.plp
  3169. $Include *>procs>send_packet.ext
  3170. $Include *>procs>mod_64.ext
  3171. $Include *>procs>rec_packet.ext
  3172. $Include *>procs>next_file.ext
  3173.  
  3174.  
  3175. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  3176.       correctly handle QUIT$ on-unit */
  3177. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  3178.         bk_hndlr entry (fixed bin);
  3179.  
  3180.   call mkonu$('QUIT$',bk_hndlr);
  3181.  
  3182. /*
  3183.  * First determine if we have exceed the number of retries that are
  3184.  * allowed to attempt to send this message
  3185.  */
  3186.   IF NUM_RETRIES > MAX_RETRIES THEN RETURN( STATE_A);
  3187. /*
  3188.  * The number of retries are not exceeded  Increment the number and then
  3189.  * attempt to send the packet again
  3190.  */
  3191.   NUM_RETRIES = NUM_RETRIES + 1;
  3192.   call SEND_PACKET (MSG_EOF, 0, MSG_NUMBER);
  3193. /*
  3194.  * Now get the responce from the remote KERMIT
  3195.  */
  3196.   IF REC_PACKET() ^= 0 THEN RETURN( STATE_A);
  3197. /*
  3198.  * Determine if the packet is good
  3199.  */
  3200.   IF ^ (REC_TYPE = MSG_ACK | REC_TYPE = MSG_NAK) THEN RETURN( STATE_A);
  3201. /*
  3202.  * If this is a NAK and the message number is not the one we just send
  3203.  * treat this like an ACK, otherwise resend the last packet
  3204.  */
  3205.   IF REC_TYPE = MSG_NAK & REC_SEQ ^= mod_64(msg_number + 1)
  3206.       THEN return(STATE_SZ);
  3207.   IF REC_SEQ ^= MSG_NUMBER THEN RETURN( STATE);
  3208. /*
  3209.  * Here to determine if there is another file to send
  3210.  */
  3211.   NUM_RETRIES = 0;
  3212.   MSG_NUMBER = mod_64(msg_number + 1);
  3213.   STATUS = NEXT_FILE ();
  3214.   IF (status ^= 0) | (STATUS = KER_NOMORFILES) THEN RETURN(STATE_SB);
  3215.                                                 ELSE RETURN(STATE_SF);
  3216.  
  3217. END;
  3218. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3219. /*SOURCE#SEND_FILE.PLP*/
  3220. send_file: procedure returns(fixed bin);
  3221. /**************************************************
  3222.  * FUNCTIONAL DESCRIPTION:
  3223.  *
  3224.  *       This routine will send the file specification that is being
  3225.  *       transfered
  3226.  *
  3227.  * CALLING SEQUENCE:
  3228.  *
  3229.  *       STATE = SEND_FILE();
  3230.  *
  3231.  * OUTPUT PARAMETERS:
  3232.  *
  3233.  *       New state to change the finite state machine to
  3234. *****************************************************/
  3235.  
  3236. $Include *>include>kercom.req
  3237. $Include *>include>kererr.req
  3238. $Include *>include>msg_types.plp
  3239. $Include *>include>states.plp
  3240. $Include *>include>kermsg_global.plp
  3241. $Include *>include>kermsg_local.plp
  3242. $Include *>include>kerfil_local.plp
  3243. $Include *>procs>rec_packet.ext
  3244. $Include *>procs>mod_64.ext
  3245. $Include *>procs>send_packet.ext
  3246. $Include *>procs>bfr_fill.ext
  3247. declare rwnd$a entry (fixed bin);
  3248.  
  3249. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  3250.       correctly handle QUIT$ on-unit */
  3251. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  3252.         bk_hndlr entry (fixed bin);
  3253.  
  3254.   call mkonu$('QUIT$',bk_hndlr);
  3255.  
  3256. /*
  3257.  * First determine if we have exceed the number of retries that are
  3258.  * allowed to attempt to send this message
  3259.  */
  3260.   if num_retries > max_retries then return(STATE_A);
  3261. /*
  3262.  * The number of retries are not exceeded  Increment the number and then
  3263.  * attempt to send the packet again
  3264.  */
  3265.   NUM_RETRIES = NUM_RETRIES + 1;
  3266.   if state = STATE_SF then do;  /* Do for file transfers */
  3267.     IF length(file_name) ^= 0 then
  3268.       snd_msg = file_name;
  3269.     call SEND_PACKET (MSG_FILE, length(file_name), MSG_NUMBER);
  3270.   end; else do;
  3271.     call send_packet(MSG_TEXT,0,msg_number);
  3272.     call rwnd$a(unit);
  3273.   end;
  3274. /*
  3275.  * Now get the responce from the remote KERMIT
  3276.  */
  3277.   IF REC_PACKET() ^= 0 THEN RETURN(STATE_A);
  3278. /*
  3279.  * Determine if the packet is good
  3280.  */
  3281.   IF ^ (REC_TYPE = MSG_ACK | REC_TYPE = MSG_NAK) THEN RETURN(STATE_A);
  3282. /*
  3283.  * If this is a NAK and the message number is not the one we just send
  3284.  * treat this like an ACK, otherwise resend the last packet
  3285.  */
  3286.   if (rec_type = msg_nak) & (rec_seq ^= mod_64(msg_number + 1))
  3287.       then return(STATE);
  3288.   IF REC_SEQ ^= MSG_NUMBER THEN RETURN(state);
  3289. /*
  3290.  * Here to send the file name to the other end
  3291.  */
  3292.   NUM_RETRIES = 0;
  3293.   MSG_NUMBER = mod_64(msg_number + 1);
  3294.   IF BFR_FILL() = KER_NORMAL THEN RETURN(STATE_SD); ELSE RETURN(STATE_A);
  3295.  
  3296. END;         /* End of SEND_FILE */
  3297. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3298. /*SOURCE#SEND_INIT.PLP*/
  3299. send_init: procedure returns(fixed bin);
  3300. /**************************************************
  3301.  * FUNCTIONAL DESCRIPTION:
  3302.  *
  3303.  *       This routine will send the initialization packet to the remote
  3304.  *       KERMIT  The message type sent is S
  3305.  *
  3306.  * CALLING SEQUENCE:
  3307.  *
  3308.  *       STATE = SEND_INIT();
  3309.  *
  3310.  * OUTPUT PARAMETERS:
  3311.  *
  3312.  *       New state to change the finite state machine to
  3313. *****************************************************/
  3314.  
  3315. $Include *>include>kercom.req
  3316. $Include *>include>kererr.req
  3317. $Include syscom>a$keys.ins.pl1
  3318. $Include *>include>msg_types.plp
  3319. $Include *>include>snd_init.plp
  3320. $Include *>include>states.plp
  3321. $Include *>include>kermsg_local.plp
  3322. $Include *>include>kermsg_global.plp
  3323. $Include *>procs>set_send_init.ext
  3324. $Include *>procs>mod_64.ext
  3325. $Include *>procs>rec_packet.ext
  3326. $Include *>procs>prs_send_init.ext
  3327. $Include *>procs>file_open.ext
  3328. $Include *>procs>send_packet.ext
  3329. $Include *>procs>a2b.ext
  3330. declare tscn$a  entry (fixed bin,fixed bin,char(*),fixed bin,fixed bin,
  3331.                        fixed bin,fixed bin,fixed bin) returns(fixed bin),
  3332.         nlen$a  entry (char(*),fixed bin) returns(fixed bin),
  3333.         wild$   entry (char(*) var,char(*) var,bin) returns(bit(1) aligned);
  3334.  
  3335. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  3336.       correctly handle QUIT$ on-unit */
  3337. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  3338.         bk_hndlr entry (fixed bin);
  3339.  
  3340.  
  3341. declare lev       fixed bin,
  3342.         log       fixed bin,
  3343.         num       fixed bin,
  3344.         code      fixed bin,
  3345.         entry     char(48),
  3346.         entry_var char(32) var,
  3347.         i         fixed bin;
  3348.  
  3349.   call mkonu$('QUIT$',bk_hndlr);
  3350.  
  3351.   int_buf_ptr = 1;
  3352.   call SET_SEND_INIT(2);
  3353.   IF NUM_RETRIES > MAX_RETRIES THEN RETURN( STATE_A);
  3354.   call send_packet(MSG_SND_INIT,P_SI_LENGTH,msg_number);
  3355.   code = rec_packet();
  3356.   if code = KER_TIMEOUT then return(state);
  3357.   if code ^= KER_NORMAL then return(STATE_A);
  3358. /*
  3359.  * Determine if the packet is good
  3360.  */
  3361.   IF ^ (REC_TYPE = MSG_ACK | REC_TYPE = MSG_NAK) THEN RETURN( STATE_A);
  3362. /*
  3363.  * If this is a NAK and the message number is not the one we just send
  3364.  * treat this like an ACK, otherwise resend the last packet
  3365.  */
  3366.   IF REC_TYPE = MSG_NAK & REC_SEQ ^= mod_64(msg_number + 1) then return(STATE);
  3367.   IF REC_SEQ ^= MSG_NUMBER THEN RETURN( STATE);
  3368. /*
  3369.  * Here if we have an ACK for the initialization message that was just sent
  3370.  * to the remote KERMIT
  3371.  */
  3372.   call PRS_SEND_INIT(2);
  3373.   NUM_RETRIES = 0;
  3374.   MSG_NUMBER = mod_64(msg_number + 1);
  3375.   matches(2) = '';
  3376.   if state = STATE_S then do;   /* Do only on file transfer */
  3377.     if file_open(FNC_READ) then do;    /* Try plain open first */
  3378.       open_flag = TRUE;
  3379.       return(STATE_SF);
  3380.     end; else do;
  3381.       file_name = translate(file_name,'ABCDEFGHIJKLMNOPQRSTUVWXYZ',
  3382.                                       'abcdefghijklmnopqrstuvwxyz');
  3383.       lev = 0;             /* TSCN$A requires we initialize the level */
  3384.       i = 1;
  3385.       matches(1) = '';
  3386.       do until (code ^= 0);
  3387.         entry = '                                                    ';
  3388.         log = tscn$a(A$CUFD,100,entry,24,num,1,lev,code);
  3389.         if code = 0 then do;
  3390.           entry_var = substr(entry,3,nlen$a(entry,34) - 2);
  3391.           if(wild$(file_name,entry_var,code) & (a2b(entry,40) ^= 4)) then do;
  3392.             matches(i) = entry_var;
  3393.             i = i + 1;
  3394.             matches(i) = '';
  3395.           end;
  3396.         end;
  3397.       end;
  3398.       snd_msg = 'Error: File does not exist on Remote System ('||file_name||')';
  3399.       file_name = matches(1);
  3400.       IF ^ FILE_OPEN (FNC_READ) then do;
  3401.         call send_packet(MSG_ERROR,length(snd_msg),msg_number);
  3402.         return(STATE_A);
  3403.       end;
  3404.       ELSE do;
  3405.         OPEN_FLAG = TRUE;
  3406.         RETURN( STATE_SF);
  3407.       END;
  3408.     end;
  3409.   end; else return(STATE_XF);
  3410.  
  3411. END;
  3412. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3413. /*SOURCE#SEND_PACKET.PLP*/
  3414. send_packet: procedure(type,len,mn);
  3415.  
  3416. declare type        char(1),     /* Type of packet to send */
  3417.         len      fixed bin,   /* Length of packet to send */
  3418.         mn          fixed bin;
  3419. /***********************************************
  3420.  * FUNCTIONAL DESCRIPTION:
  3421.  *
  3422.  *       This routine will cause a packet to be sent over the line
  3423.  *       that has been opened by OPEN_TERMINAL
  3424.  *
  3425.  * CALLING SEQUENCE:
  3426.  *
  3427.  *       SEND_PACKET(Type, Length);
  3428.  *
  3429.  * INPUT PARAMETERS:
  3430.  *
  3431.  *       TYPE - Type of packet to send
  3432.  *
  3433.  *       LENGTH - Length of the packet being sent
  3434. **************************************************/
  3435.  
  3436. $Include *>include>packet_defs.plp
  3437. $Include *>include>kermsg_global.plp
  3438. $Include *>include>kercom.req
  3439. $Include *>include>kermsg_local.plp
  3440. $Include *>procs>char.ext
  3441. $Include *>procs>b2a.ext
  3442. $Include *>procs>a2b.ext
  3443.  
  3444. declare fill$a   entry (char(*),fixed bin,fixed bin);
  3445. declare chks     entry (char(*) var) returns(fixed bin);
  3446.  
  3447. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  3448.       correctly handle QUIT$ on-unit */
  3449. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  3450.         bk_hndlr entry (fixed bin);
  3451.  
  3452.  
  3453. declare filler     char(MAX_MSG),
  3454.         msg        char(MAX_MSG) var,
  3455.         1 char_var based,
  3456.           2 len    fixed bin,
  3457.           2 data   char(80),
  3458.         i          fixed bin,
  3459.         chksum     fixed bin,       /* Checksum */
  3460.         ptr        pointer;     /* Pointer to information */
  3461.  
  3462.   call mkonu$('QUIT$',bk_hndlr);
  3463.  
  3464. /*
  3465.  * Do any filler processing that the remote KERMIT requires
  3466.  */
  3467.   if snd_npad ^= 0 then do;
  3468.     /* Fill only npad characters */
  3469.     call fill$a(filler,snd_npad,a2b(snd_padchar,1));
  3470.     call tnoua(filler,snd_npad);
  3471.   end;
  3472. /*
  3473.  * Store the header information into the message
  3474.  */
  3475.   msg=''!!char(b2a(len+pkt_ovr_head),1)!!char(b2a(mn),1)!!type;
  3476.   if len ^= 0 then msg = msg || snd_msg;
  3477. /*
  3478.  * Do the initial checksum calculation and set up the pointer to read
  3479.  * characters from the message dependent part of the message
  3480.  */
  3481.   chksum = chks(msg);
  3482. /*
  3483.  * Store the checksum into the message
  3484.  */
  3485.  msg = msg!! char(b2a(chksum),1);
  3486. /*
  3487.  * Now call the O/S routine to send the message out to the remote KERMIT
  3488.  */
  3489.   call tnou(addr(msg)->char_var.data,length(msg));
  3490.   return;
  3491.  
  3492. END;                         /* End of SEND_PACKET */
  3493. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3494. /*SOURCE#SEND_SWITCH.PLP*/
  3495. send_switch: procedure(init_state) returns(bit(1));
  3496.  
  3497. declare init_state  fixed bin;
  3498. /**************************************************
  3499.  * FUNCTIONAL DESCRIPTION:
  3500.  *
  3501.  *       This routine is the state table switcher for sending files  It
  3502.  *       loops until either it is finished or an error is encountered  The
  3503.  *       routines called by SEND_SWITCH are responsible for changing the state
  3504.  *
  3505.  * CALLING SEQUENCE:
  3506.  *
  3507.  *       SEND_SWITCH();
  3508.  *
  3509.  * OUTPUT PARAMETERS:
  3510.  *
  3511.  *       Returns:
  3512.  *           TRUE - File sent correctly
  3513.  *           FALSE - Aborted sending the file
  3514. *****************************************************/
  3515.  
  3516. $Include *>include>kercom.req
  3517. $Include *>include>states.plp
  3518. $Include *>include>kermsg_global.plp
  3519. $Include *>include>kermsg_local.plp
  3520. $Include *>include>kerfil_global.plp
  3521. $Include *>procs>send_data.ext
  3522. $Include *>procs>send_file.ext
  3523. $Include *>procs>send_eof.ext
  3524. $Include *>procs>send_init.ext
  3525. $Include *>procs>send_break.ext
  3526. $Include *>procs>file_close.ext
  3527. declare sleep$ entry (fixed bin(31));
  3528.  
  3529. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  3530.     correctly handle QUIT$ on-unit */
  3531. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  3532.         bk_hndlr entry (fixed bin);
  3533.  
  3534.  
  3535. declare
  3536.         status       fixed bin,
  3537.         save_8quote  char(1),
  3538.         save_file    fixed bin,
  3539.         VAL_RETURN   fixed bin,
  3540.         FINISHED     fixed bin;
  3541.  
  3542.   call mkonu$('QUIT$',bk_hndlr);
  3543.  
  3544.   STATE = init_state;              /* Initial state setup */
  3545.   NUM_RETRIES = 0;                 /* Initialize number of retries */
  3546.   MSG_NUMBER = 0;                  /* Initial message number */
  3547.  
  3548. /* Sleep if the user wanted us to */
  3549.   if delay ^= 0 then call sleep$(1000 * delay);
  3550.  
  3551.   FINISHED = FALSE;
  3552.   do until(finished = TRUE);
  3553.     select (state);
  3554.       when (STATE_SD) state = send_data();
  3555.       when (STATE_SF,STATE_XF) state = send_file();
  3556.       when (STATE_SZ) state = send_eof();
  3557.       when (STATE_S) do;
  3558.         save_file = file_type;
  3559.         save_8quote = rcv_8quote_chr;
  3560.         state = send_init();
  3561.       end;
  3562.       when (STATE_X) do;
  3563.         save_file = file_type;
  3564.         file_type = FILE_ASC;
  3565.         save_8quote = rcv_8quote_chr;
  3566.         rcv_8quote_chr = 'N';       /* 8-bit-quoting off for text */
  3567.         state = send_init();
  3568.       end;
  3569.       when (STATE_SB) state = send_break();
  3570.       when (STATE_C) do;
  3571.         FINISHED = TRUE;
  3572.         VAL_RETURN = TRUE;
  3573.       END;
  3574.       when (STATE_A) do;
  3575.         if open_flag then do;
  3576.           status = file_close(FNC_READ);
  3577.           OPEN_FLAG = FALSE;
  3578.         END;
  3579.         FINISHED = TRUE;
  3580.         VAL_RETURN = FALSE;
  3581.       END;
  3582.       otherwise do;
  3583.         FINISHED = TRUE;
  3584.         VAL_RETURN = FALSE;
  3585.       END;
  3586.     end;
  3587.  
  3588.   end;
  3589.   file_type = save_file;
  3590.   rcv_8quote_chr = save_8quote;
  3591.   RETURN (VAL_RETURN);
  3592.  
  3593. END;
  3594. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3595. /*SOURCE#SET_SEND_INIT.PLP*/
  3596. set_send_init: procedure(order);
  3597.  
  3598. declare order   fixed bin;
  3599. /***********************************************
  3600.  * FUNCTIONAL DESCRIPTION:
  3601.  *
  3602.  *       This routine will initialize the various parameters for the
  3603.  *       MSG_SND_INIT message
  3604.  *
  3605.  * CALLING SEQUENCE:
  3606.  *
  3607.  *       SET_SEND_INIT();
  3608.  *
  3609.  * IMPLICIT OUTPUTS:
  3610.  *
  3611.  *       SND_MSG parameters set up
  3612. **************************************************/
  3613.  
  3614. $Include *>include>kermsg_global.plp
  3615. $Include *>include>kercom.req
  3616. $Include *>include>kermsg_local.plp
  3617. $Include *>include>kerfil_global.plp
  3618. $Include *>procs>char.ext
  3619. $Include *>procs>b2a.ext
  3620. $Include *>procs>ctl.ext
  3621.  
  3622. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  3623.       correctly handle QUIT$ on-unit */
  3624. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  3625.         bk_hndlr entry (fixed bin);
  3626.  
  3627.   call mkonu$('QUIT$',bk_hndlr);
  3628.  
  3629.   if order = 2 then do;             /* We're sending send init */
  3630.     if file_type ^= FILE_BIN then rcv_8quote_chr = 'N';
  3631.   end;
  3632.  
  3633.   snd_msg = char(b2a(rcv_pkt_size),1)||char(b2a(rcv_timeout),1)||
  3634.             char(b2a(rcv_npad),1)||ctl(rcv_padchar,1)||char(rcv_eol,1)||
  3635.             rcv_quote_chr||rcv_8quote_chr;
  3636.  
  3637.   if order = 1 then do;    /* Remote sent send init, this is ACK */
  3638.     if snd_8quote_chr = 'Y' then snd_8quote_chr = rcv_8quote_chr;
  3639.     else if rcv_8quote_chr = 'Y' then rcv_8quote_chr = snd_8quote_chr;
  3640.   end;
  3641.  
  3642. END;                                        /* End of SET_SEND_INIT */
  3643. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3644. /*SOURCE#SHIFT.PMA*/
  3645.          ENT     SHIFT,SHFECB  ENTRY POINTS
  3646.  
  3647.         SEG
  3648. *
  3649. SHIFT   EQU     *
  3650.         ARGT                   ARGUMENT TRANSFER
  3651.         LDA     LEN,*          PLACE ARGUMENT (INTEGER*16) IN REG A
  3652.         ARL     1              SHIFT RIGHT 1 PLACE (DIVIDE BY 2)
  3653.         PRTN                   RETURN TO CALLER
  3654. *
  3655.         DYNM    LEN(3)
  3656. *
  3657. SHFECB  ECB     SHIFT,,LEN,1
  3658. *
  3659.         END
  3660. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3661. /*SOURCE#TIMEOUT_HNDLR.PLP*/
  3662. /*       TIMEOUT_HNDLR : on_unit for receive timeout (ALARM$ condition)
  3663.  */
  3664.  
  3665. timeout_hndlr: proc( dummy );
  3666.      dcl dummy pointer;
  3667.  
  3668.      dcl timeout label external;
  3669.      goto timeout;
  3670. end;
  3671.  
  3672. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3673. /*SOURCE#TYPE.PLP*/
  3674. type: procedure(token,table_ptr,table_len) returns(fixed bin);
  3675.  
  3676. declare token        char(32) var,  /* Token number in token array */
  3677.         table_len    fixed bin,     /* Number of strings in parsing table */
  3678.         table_ptr    pointer,
  3679.         table        (5) char(26) var based; /* Parsing table */
  3680.  
  3681. $Include *>include>kermit_local.plp
  3682.  
  3683. declare i      fixed bin;
  3684.  
  3685. /* next 3 lines added 05-08-84 by C. Devine at SPSS, Inc. to handle
  3686.     break properly */
  3687. declare mkonu$     entry (char(32) var, entry) options(shortcall(20)),
  3688.         bk_hndlr   entry (fixed bin);
  3689.   call mkonu$('QUIT$',bk_hndlr);
  3690.  
  3691.   do i = 1 to table_len;
  3692.     if table_ptr->table(i) = token then return(i);
  3693.   end;
  3694.   return(0);
  3695.  
  3696. end;
  3697. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3698. /*SOURCE#UNCHAR.PLP*/
  3699. /*
  3700.  * UNCHAR: Make character unprintable.
  3701.  */
  3702. unchar: procedure(char_str,pos) returns(char(1));
  3703.  
  3704. declare char_str   char(80),
  3705.         pos        fixed bin;   /* Character position w/in char_str */
  3706.  
  3707. declare fixed_bin  fixed bin,   /* To do arithmetic on character */
  3708.         c2         char(2) based,  /* Overlays fixed_bin */
  3709.         c1         char(1);     /* Return value */
  3710.  
  3711. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  3712.       correctly handle QUIT$ on-unit */
  3713. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  3714.         bk_hndlr entry (fixed bin);
  3715.  
  3716.   call mkonu$('QUIT$',bk_hndlr);
  3717.  
  3718.   fixed_bin = 0;    /* Init so things turn out as expected */
  3719.   substr(addr(fixed_bin)->c2,2,1) = substr(char_str,pos,1); /* Xfer input
  3720.       to low order byte of fixed_bin */
  3721.   fixed_bin = fixed_bin - 32;  /* Turn off "printable" bit */
  3722.   c1 = substr(addr(fixed_bin)->c2,2,1);
  3723.   return(c1);
  3724.  
  3725. end;
  3726. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3727. /*SOURCE#WILD$_DYNT.PMA*/
  3728.         SEG
  3729.         DYNT    WILD$
  3730.         END
  3731. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3732. /*SOURCE#SERVER.PLP*/
  3733. server: procedure;
  3734.  
  3735. $Include *>include>kercom.req
  3736. $Include *>include>kererr.req
  3737. $Include *>include>packet_defs.plp
  3738. $Include *>include>msg_types.plp
  3739. $Include *>include>snd_init.plp
  3740. $Include *>include>states.plp
  3741. $Include *>include>kermsg_global.plp
  3742. $Include *>include>kermsg_local.plp
  3743. $Include *>procs>prs_send_init.ext
  3744. $Include *>procs>mod_64.ext
  3745. $Include *>procs>set_send_init.ext
  3746. $Include *>procs>send_packet.ext
  3747. $Include *>procs>rec_worker_switch.ext
  3748. $Include *>procs>send_switch.ext
  3749. $Include *>procs>rec_message.ext
  3750.  
  3751. declare duplx$ entry (bit(16)) returns(bit(16)),
  3752.         temp$a entry (fixed bin,char(*),fixed bin,fixed bin),
  3753.         wtlin$ entry (fixed bin,char(*),fixed bin,fixed bin),
  3754.         tscn$a entry (fixed,fixed,char(*),fixed,fixed,fixed,fixed,fixed),
  3755.         nlen$a entry (char(*),fixed bin) returns(fixed bin);
  3756.  
  3757. /*  next section added 25 Apr 84 by C. Devine at SPSS, Inc. to
  3758.       correctly handle QUIT$ on-unit */
  3759. declare mkonu$ entry (char(32) var, entry) options(shortcall(20)),
  3760.         bk_hndlr entry (fixed bin);
  3761.  
  3762.  
  3763. declare status_bit bit(1) aligned,
  3764.         text     char(96) var,
  3765.         status   fixed bin,
  3766.         code       fixed bin,
  3767.         num        fixed bin,
  3768.         lev        fixed bin,
  3769.         entry      char(48),
  3770.         1 char_var based,
  3771.           2 len    fixed bin,
  3772.           2 data   char(80),
  3773.         my_duplex  bit(16) aligned external;
  3774.  
  3775.   call mkonu$('QUIT$',bk_hndlr);
  3776.  
  3777.   server_generic: procedure returns(fixed bin);
  3778.   /**************************************************
  3779.    * FUNCTIONAL DESCRIPTION:
  3780.    *
  3781.    *       This routine will handle the generic server messages
  3782.    *       The generic server messages include FINISH, LOGOUT,
  3783.    *       CONNECT (ATTACH), DELETE, DIRECTORY
  3784.    *
  3785.    * CALLING SEQUENCE:
  3786.    *
  3787.    *       SERVER_GENERIC();
  3788.    *
  3789.    * IMPLICIT INPUTS:
  3790.    *
  3791.    *       Generic message receive in REC_MESSAGE
  3792.    *
  3793.    *****************************************************/
  3794.  
  3795. $Include syscom>errd.ins.pl1
  3796. $Include syscom>keys.ins.pl1
  3797. $Include syscom>a$keys.ins.pl1
  3798. $Include *>include>kerfil_local.plp
  3799. $Include *>procs>shift.ext
  3800.  
  3801.   declare temporary  fixed bin external init(0);
  3802.  
  3803.   declare at$    entry (fixed bin,char(*) var,fixed bin),
  3804.           srch$$ entry (fixed,char(*),fixed,fixed,fixed,fixed),
  3805.           logo$$ entry (fixed,fixed,char(*),fixed,fixed bin(31),fixed);
  3806.  
  3807.   declare treename   char(96) var,
  3808.           fname      char(6),
  3809.           type       fixed bin;
  3810.  
  3811. declare mkonu$     entry (char(32) var, entry) options(shortcall(20)),
  3812.         bk_hndlr   entry (fixed bin);
  3813.   call mkonu$('QUIT$',bk_hndlr);
  3814.  
  3815.     /* Process based on message type */
  3816.     select(substr(rec_msg,PKT_MSG,1));
  3817.  
  3818.       when (MSG_GEN_CONNECT) do;
  3819.         treename = substr(rec_msg,6,length(rec_msg) - 6);
  3820.         call at$(K$SETH,treename,code);
  3821.         select (code);
  3822.           when (0) do;
  3823.             call temp$a(A$SAMF+A$GETU,fname,6,unit);
  3824.             file_name = substr(fname,1,6);
  3825.             temporary = 1;   /* Working with TEMP file */
  3826.             call wtlin$(unit,'Now in directory '||treename||' ',
  3827.                 shift(length(treename)+18),code);
  3828.             call send_switch(STATE_X);
  3829.           end;
  3830.           when (E$ITRE) text = 'Illegal treename';
  3831.           when (E$FNTF) text = 'Some part of the treename does not exist';
  3832.           when (E$NRIT) text = 'Insufficient access rights';
  3833.           otherwise text = 'Bad error, call STC at once!';
  3834.         end;
  3835.         if code ^= 0 then do;
  3836.           snd_msg = text;
  3837.           call send_packet(MSG_ERROR,length(snd_msg),msg_number);
  3838.         end;
  3839.       end;
  3840.  
  3841.       when (MSG_GEN_EXIT) do;
  3842.         call send_packet(MSG_ACK,0,rec_seq);
  3843.         code = duplx$(my_duplex);
  3844.         RETURN( KER_EXIT);
  3845.       end;
  3846.  
  3847.       when (MSG_GEN_LOGOUT) do;
  3848.         call send_packet(MSG_ACK,0,rec_seq);
  3849.         code = duplx$(my_duplex);
  3850.         call logo$$(0,0,' ',0,0,code);
  3851.       end;
  3852.  
  3853.       when (MSG_GEN_DELETE) do;
  3854.         treename = substr(rec_msg,6,length(rec_msg) - 6);
  3855.         call srch$$(K$DELE,addr(treename)->char_var.data,length(treename),
  3856.                     unit,type,code);
  3857.         if code ^= 0 then do;
  3858.           snd_msg = 'File delete unsuccessful';
  3859.           call send_packet(MSG_ERROR,length(snd_msg),msg_number);
  3860.         end;
  3861.         else do;
  3862.           call temp$a(A$SAMF+A$GETU,fname,6,unit);
  3863.           file_name = substr(fname,1,6);
  3864.           temporary = 1;    /* Working with TEMP file */
  3865.           call wtlin$(unit,'File Deleted',6,code);
  3866.           call send_switch(STATE_X);
  3867.         end;
  3868.       end;
  3869.  
  3870.       when (MSG_GEN_DIRECTORY) do;
  3871.         call temp$a(A$SAMF+A$GETU,fname,6,unit);
  3872.         file_name = substr(fname,1,6);
  3873.         temporary = 1;  /* Working with TEMP file */
  3874.         call wtlin$(unit,'Beginning of Directory Listing',15,code);
  3875.         lev = 0;
  3876.         do until (code ^= 0);
  3877.           text = (76) ' ';
  3878.           call tscn$a(A$CUFD,100,entry,24,num,1,lev,code);
  3879.           if code = 0 then do;
  3880.             substr(text,1,nlen$a(entry,34) - 2) =
  3881.                      substr(entry,3,nlen$a(entry,34) - 2);
  3882.             call tscn$a(A$CUFD,100,entry,24,num,1,lev,code);
  3883.             if code = 0 then do;
  3884.               substr(text,36,nlen$a(entry,34)-2) =
  3885.                        substr(entry,3,nlen$a(entry,34)-2);
  3886.             end;
  3887.             call wtlin$(unit,addr(text)->char_var.data,35,num);
  3888.           end;
  3889.         end;
  3890.         call wtlin$(unit,'End of Directory Listing',12,code);
  3891.         call send_switch(STATE_X);
  3892.       end;
  3893.  
  3894.       otherwise do;
  3895.         snd_msg = 'Unimplemented command; try again!';
  3896.         call send_packet(MSG_ERROR,length(snd_msg),msg_number);
  3897.         return( KER_UNIMPLGEN);
  3898.       end;
  3899.  
  3900.     end;  /* select */
  3901.  
  3902.     return(KER_NORMAL);
  3903.  
  3904.   end;    /* End of SERVER_GENERIC */
  3905.  
  3906.  
  3907. /**************************************************
  3908.  * FUNCTIONAL DESCRIPTION:
  3909.  *
  3910.  *       This routine will handle the server function in the v20 protocol
  3911.  *       for KERMIT. This routine by it's nature will call various operating
  3912.  *       system routines to do things like logging off the system
  3913.  *
  3914.  * CALLING SEQUENCE:
  3915.  *
  3916.  *       EXIT_FLAG = SERVER();
  3917.  *****************************************************/
  3918.  
  3919. /* Set the terminal line so echo is off */
  3920.   my_duplex = duplx$('FFFF'B4);
  3921.   code = duplx$('A000'B4);
  3922.  
  3923. /* Initialize retry count */
  3924.   num_retries = 0;
  3925.  
  3926. /* Main server loop */
  3927.   do while(1);
  3928.  
  3929.     /* Get input from line */
  3930.     status_bit = REC_MESSAGE (CHECK_SERVER);
  3931.     /* Process based on message type */
  3932.     select (rec_type);
  3933.  
  3934.       when (MSG_SND_INIT) do;
  3935.         msg_number = mod_64(rec_seq + 1);
  3936.         call PRS_SEND_INIT(1);
  3937.         call SET_SEND_INIT(1);
  3938.         call send_packet(MSG_ACK,P_SI_LENGTH,rec_seq);
  3939.         STATE = STATE_RF;
  3940.         code = REC_WORKER_SWITCH ();
  3941.       end;
  3942.  
  3943.       when (MSG_RCV_INIT) do;
  3944.         MSG_NUMBER = REC_SEQ;
  3945.         IF REC_LENGTH > 0 then do;
  3946.           file_name = substr(rec_msg,PKT_MSG,rec_length - pkt_msg);
  3947.         END;
  3948.         DELAY = 0;
  3949.         call SEND_SWITCH(STATE_S);
  3950.       end;
  3951.  
  3952.       when (MSG_KERMIT) do;  /* Generic Kermit Commands */
  3953.         status = SERVER_GENERIC ();
  3954.         if status = KER_EXIT then return;
  3955.       end;
  3956.     end; /* select */
  3957.   end;
  3958.  
  3959. /* Reset user terminal characteristics (e.g. turn echo on) */
  3960.   code = duplx$(my_duplex);
  3961.  
  3962. END;       /* End of GLOBAL ROUTINE SERVER */
  3963. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  3964. /*SOURCE#KERTRN.FTN*/
  3965.       SUBROUTINE KERTRN
  3966. C *********************************************************************
  3967. C *********************************************************************
  3968. C **                                                                 **
  3969. C **                                                                 **
  3970. C **  KERTRN.FTN     TRANSLATION PROGRAM FOR SPSS-X PORTABLE FILES   **
  3971. C **       ALLOWS TRANSFER OF FILES BETWEEN PRIME AND IBM PC         **
  3972. C **                                                                 **
  3973. C **                                                                 **
  3974. C *********************************************************************
  3975. C *********************************************************************
  3976. C
  3977. C        ***  M O D I F I C A T I O N    H I S T O R Y  ***
  3978. C
  3979. C     04 MAY 84  - C. DEVINE - ORIGINAL VERSION
  3980. C     08 MAY 84  - C. DEVINE - STRIP LENGTH INDICATORS FROM DAM FILES
  3981. C                              GOING TO PC; ADD THEM COMING FROM PC
  3982. C
  3983. $INSERT SYSCOM>KEYS.F
  3984. $INSERT SYSCOM>ERRD.F
  3985. $INSERT SYSCOM>A$KEYS.INS.FTN
  3986. C   ALL     WORK VARIABLE USED FOR BIT ROTATION
  3987.       INTEGER*4 ALL
  3988. C   ALPHA   AREA TO PLACE TRANSLATED BUFFER. HOLDS 80 CHARACTERS
  3989.       INTEGER*4 ALPHA(20)
  3990. C   BUFFER  AREA FOR PRWF$$ READS. HOLDS 80 CHARACTERS
  3991.       INTEGER*4 BUFFER(20)
  3992. C   CHAR    CHARACTER COUNT TO LOCATE TRANSLATION TABLE
  3993.       INTEGER*2 CHAR
  3994. C   CNT     NUMBER OF ARRAY ELEMENTS FILLED BY PRWF$$ (RNW/2 + 1)
  3995.       INTEGER*2 CNT
  3996. C   CODE    RETURNED ERROR CODE IN PRWF$$ CALLS
  3997.       INTEGER*2 CODE
  3998. C   DUMMY   READ OUT DAM FILE LENGTH INDICATORS
  3999.       INTEGER*2 DUMMY
  4000. C   FLAG    FLAG FOR TRANSLATION TYPE
  4001.       INTEGER*2 FLAG
  4002. C   I       INDEX FOR LOOP
  4003.       INTEGER*2 I
  4004. C   IC1     ERROR CODE FOR INPUT FILE SRCH$$ CALL
  4005.       INTEGER*2 IC1
  4006. C   IC2     ERROR CODE FOR OUTPUT FILE SRCH$$ CALL
  4007.       INTEGER*2 IC2
  4008. C   INAME   INPUT FILE NAME.  MAXIMUM OF 32 CHARACTERS
  4009.       INTEGER*4 INAME(8)
  4010. C   IT1     TYPE CODE FOR INPUT FILE SRCH$$ CALL
  4011.       INTEGER*2 IT1
  4012. C   IT2     TYPE CODE FOR OUTPUT FILE SRCH$$ CALL
  4013.       INTEGER*2 IT2
  4014. C   J       INDEX FOR LOOP
  4015.       INTEGER*2 J
  4016. C   KEY     KEY = K$NSAM FOR PC-BOUND FILES; K$NDAM PRIMEWARD
  4017.       INTEGER*2 KEY
  4018. C   N(4)    WORK VECTOR TO HOLD SHIFTED BITS
  4019.       INTEGER*4 N(4)
  4020. C   NW      NUMBER OF WORDS FOR PRWF$$ CALL
  4021.       INTEGER*2 NW
  4022. C   POS     MARKER FOR POSITION IN ALPHA VECTOR
  4023.       INTEGER*2 POS
  4024. C   RNW     RETURNED NUMBER OF WORD FROM PRWF$$ CALL
  4025.       INTEGER*2 RNW
  4026. C   UNITI   RETURNED FILE UNIT NUMBER FOR INPUT FILE
  4027.       INTEGER*2 UNITI
  4028. C   UNITO   RETURNED FILE UNIT NUMBER FOR OUTPUT FILE
  4029.       INTEGER*2 UNITO
  4030. C   ONAME   OUTPUT FILE NAME.  MAXIMUM OF 32 CHARACTERS
  4031.       INTEGER*4 ONAME(8)
  4032. C
  4033. C                                 ** SET UP COMMON BLOCK FOR BREAK
  4034. C                                 ** HANDLER
  4035.       COMMON /BRKCOM/ UNITI,UNITO,ONAME
  4036.       EXTERNAL BRKCLN
  4037.       CALL MKON$F('QUIT$',5,BRKCLN)
  4038. C
  4039. C                                 ** SET THE FLAG FOR CONVERSION TYPE
  4040. C                                 ** FLAG=1  FORMAT FOR PC FROM PRIME
  4041. C                                 ** FLAG=-1 FORMAT FOR PRIME FROM PC
  4042. C
  4043.       UNITI = 0
  4044.       UNITO = 0
  4045.       FLAG = 0
  4046.       KEY = 0
  4047.    10 CONTINUE
  4048.       IF (.NOT. YSNO$A('Are you converting a file to send to a PC',41,
  4049.      +                  A$NDEF)) GOTO 15
  4050.           FLAG = 1
  4051.           KEY = K$NSAM
  4052.           GOTO 20
  4053.    15 CONTINUE
  4054.       IF (.NOT. YSNO$A('Are you converting a file received from a PC',
  4055.      +                  44,A$NDEF)) GOTO 10
  4056.           FLAG = -1
  4057.           KEY = K$NDAM
  4058. C
  4059. C                                  ** GET INPUT AND OUTPUT FILE NAMES
  4060. C                                  ** CHECK EXISTENCE OF OUTPUT FILE
  4061. C                                  ** AND VERIFY ANY OVERWRITE
  4062. C
  4063.    20 CONTINUE
  4064.         CALL FILL$A(INAME,32,' ')
  4065.         CALL TNOUA('Name of file to convert: ',25)
  4066.         READ(1,8010,ERR=20)INAME
  4067.  8010   FORMAT (8A4)
  4068.         CALL SRCH$$(K$READ+K$GETU,INAME,32,UNITI,IT1,IC1)
  4069.         IF (IC1 .NE. 0) GOTO 20
  4070.    30 CONTINUE
  4071.         CALL FILL$A(ONAME,32,' ')
  4072.         CALL TNOUA('Name for converted file: ',25)
  4073.         READ(1,8010,ERR=30)ONAME
  4074.         CALL SRCH$$(K$EXST,ONAME,32,0,IT2,IC2)
  4075.         IF (IC2 .EQ. E$FNTF) GOTO 35
  4076.         IF (.NOT. YSNO$A('File already exists. Do you wish to overwrite'
  4077.      +              ,45,A$NDEF)) GOTO 30
  4078.         CALL SRCH$$(K$DELE+K$GETU,ONAME,32,UNITO,IT2,IC2)
  4079.    35   CONTINUE
  4080.         CALL SRCH$$(K$WRIT+KEY+K$GETU,ONAME,32,UNITO,IT2,IC2)
  4081.         IF (IC2 .NE. 0) GOTO 30
  4082. C
  4083. C                                 ** CONVERT PRIME PORTABLE FILE FOR PC
  4084. C                                 ** REMOVE CONTROL CHARACTERS FROM
  4085. C                                 ** TRANSLATION TABLES AND WRITE TO FILE
  4086. C                                 ** WITH CARRIAGE RETURN/LINE FEED
  4087. C
  4088.       IF (FLAG .NE. 1) GOTO 300
  4089.       CHAR = 0
  4090.   100 CONTINUE
  4091.       DO 110 I=1,20
  4092.         ALPHA(I) = INTL(0)
  4093.         BUFFER(I) = INTL(0)
  4094.   110 CONTINUE
  4095.       NW = 1
  4096.       CALL PRWF$$(K$READ,UNITI,LOC(DUMMY),NW,INTL(0),RNW,CODE)
  4097.       IF (RNW .EQ. 0) GOTO 1000
  4098.       NW = 40
  4099.       CALL PRWF$$(K$READ,UNITI,LOC(BUFFER(1)),NW,INTL(0),RNW,CODE)
  4100.       IF (RNW .EQ. 0) GOTO 1000
  4101.       CNT = (RNW/2) + 1
  4102.       IF (CNT .GT. 20) CNT = 20
  4103.       DO 175 I=1,CNT
  4104.         ALL = BUFFER(I)
  4105.         DO 150 J=1,4
  4106.           CHAR = CHAR + 1
  4107.           POS = (I-1)*4 + J
  4108.           N(J) = LT(ALL,8)
  4109.           N(J) = RS(N(J),24)
  4110.           ALL = LS(ALL,8)
  4111.           IF (CHAR .GT. 456) GOTO 140
  4112.           IF (N(J) .GE. 32 .AND. N(J) .LT. 127) GOTO 140
  4113.           IF (N(J) .GE. 160 .AND. N(J) .LT. 255) GOTO 140
  4114.             CALL MCHR$A(ALPHA,POS,'0',1)
  4115.             GOTO 150
  4116.   140     CONTINUE
  4117.             CALL MCHR$A(ALPHA,POS,N(J),4)
  4118.   150   CONTINUE
  4119.   175 CONTINUE
  4120.       CALL O$AD08(UNITO,ALPHA,NW,0)
  4121.       GOTO 100
  4122. C
  4123. C                                 ** CONVERT PC FORM TO PRIME FORM
  4124. C                                 ** REMOVE CR/LF FROM RECORD
  4125. C
  4126.   300 CONTINUE
  4127.       IF (FLAG .NE. -1) GOTO 500
  4128.       DUMMY = 40
  4129.   310 CONTINUE
  4130.       NW = 40
  4131.       CALL RDLIN$(UNITI,BUFFER,NW,CODE)
  4132.       IF (CODE .NE. 0) GOTO 1000
  4133.       CALL PRWF$$(K$WRIT,UNITO,LOC(DUMMY),1,INTL(0),RNW,CODE)
  4134.       CALL PRWF$$(K$WRIT,UNITO,LOC(BUFFER(1)),NW,INTL(0),RNW,CODE)
  4135.       GOTO 310
  4136. C
  4137. C                                 ** FLAG IS INVALID
  4138. C                                 ** THIS SHOULD NEVER OCCUR
  4139. C
  4140.   500 CONTINUE
  4141.       CALL TNOU('Invalid conversion selected')
  4142. C
  4143. C                                 **  CLOSE FILES AND EXIT
  4144. C
  4145.  1000 CONTINUE
  4146.       CALL SRCH$$(K$CLOS,0,0,UNITI,IT1,IC1)
  4147.       CALL SRCH$$(K$CLOS,0,0,UNITO,IT2,IC2)
  4148.       RETURN
  4149.       END
  4150. C
  4151. C     BRKCLN  -  THE BREAK HANDLING ROUTINE
  4152. C
  4153.       SUBROUTINE BRKCLN
  4154. $INSERT SYSCOM>KEYS.F
  4155.       INTEGER*2 ITYPE,ICODE
  4156.       INTEGER*2 UNITI
  4157.       INTEGER*2 UNITO
  4158.       INTEGER*4 ONAME(8)
  4159.       COMMON /BRKCOM/ UNITI,UNITO,ONAME
  4160.       CALL TONL
  4161.       IF (UNITI .NE. 0) CALL SRCH$$(K$CLOS,0,0,UNITI,ITYPE,ICODE)
  4162.       IF (UNITO .EQ. 0) GOTO 10
  4163.         CALL TNOU('Converted file deleted on QUIT condition',40)
  4164.         CALL SRCH$$(K$CLOS,0,0,UNITO,ITYPE,ICODE)
  4165.         CALL SRCH$$(K$DELE,ONAME,32,UNITO,ITYPE,ICODE)
  4166. 10    CONTINUE
  4167.       CALL TNOU('Exiting from Kermit-R19',23)
  4168.       CALL EXIT
  4169.       END
  4170. :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  4171.