home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / extra / prott.bli < prev    next >
Text File  |  1988-08-16  |  9KB  |  578 lines

  1. MODULE KERTT (IDENT = '2.0.004'
  2.         ) =
  3. BEGIN
  4.  
  5. SWITCHES LANGUAGE (COMMON);
  6.  
  7. !<BLF/WIDTH:100>
  8.  
  9. !++
  10. ! FACILITY:
  11. !
  12. !    KERMIT text processing
  13. !
  14. ! ABSTRACT:
  15. !
  16. !    This module contains all of the text processing required for
  17. !    KERMSG.
  18. !
  19. ! ENVIRONMENT:
  20. !
  21. !    TOPS-10, P/OS, VAX/VMS
  22. !
  23. ! AUTHOR: Robert C. McQueen, CREATION DATE: 29-August-1983
  24. !--
  25.  
  26.  
  27. %SBTTL 'Table of Contents'
  28. !
  29. ! TABLE OF CONTENTS:
  30. !
  31.  
  32. %SBTTL 'Revision History'
  33.  
  34. !++
  35. !
  36. ! Create this module for PRO/Kermit 1.0, Kermit-10 2(100) and Kermit-32 1.2
  37. !
  38. ! 1.2.000    By: Robert C. McQueen            On: 29-August-1983
  39. !        Create this module.
  40. !
  41. ! 1.2.001    By: Robert C. McQueen        On: 9-Sept-1983
  42. !        Make the string passed to TERM_DUMP a counted ASCIZ string,
  43. !        not a counted ASCII string.
  44. !
  45. ! 1.2.002    By: Robert C. McQueen        On: 16-September-1983
  46. !        Make TT_OUTPUT a global routine, so we can force information
  47. !        output a various points in time.
  48. !
  49. ! 2.0.003    Release for TOPS-10 KERMIT-10 version 2.
  50. !        Release for VAX/VMS KERMIT-32 version 2.
  51. !
  52. ! 2.0.004    By: Nick Bush            On: 22-December-1983
  53. !        Add TT_HOLD to indicate that output should not be dumped
  54. !        when LF's are seen, only when buffer is full.
  55. !--
  56.  
  57.  
  58. %SBTTL 'Library files'
  59. !
  60. ! INCLUDE FILES:
  61. !
  62. !
  63. ! KERMIT common definitions
  64. !
  65.  
  66. REQUIRE 'KERCOM';
  67.  
  68.  
  69. %SBTTL 'Symbol definitions'
  70. !
  71. ! EQUATED SYMBOLS:
  72. !
  73.  
  74. LITERAL
  75.     TEXT_BFR_LENGTH = 256;            ! Length of the text buffer
  76.  
  77.  
  78. %SBTTL 'Storage'
  79. !
  80. ! OWN STORAGE:
  81. !
  82. !
  83. ! TT_xxxxx routine storage
  84. !
  85.  
  86. OWN
  87.     HOLD_FLAG,                    ! Output should be held even if CRLF seen
  88.     DUMP_ROUTINE,                ! Address of routine to dump text
  89.     TEXT_COUNT,                    ! Count of the characters
  90.     TEXT_POINTER,                ! Pointer to store characters
  91.     TEXT_BUFFER : VECTOR [CH$ALLOCATION (TEXT_BFR_LENGTH)];    ! Buffer of characters
  92.  
  93.  
  94. %SBTTL 'External storage'
  95.  
  96. !++
  97. ! The following is the various external storage locations that are
  98. ! referenced from this module.
  99. !--
  100.  
  101. !
  102. ! KERMSG storage
  103. !
  104.  
  105. EXTERNAL
  106.     CONNECT_FLAG;                ! Flag if communications line is TT:
  107.  
  108. !++
  109. ! The following is the only external routine used by this module.  This
  110. ! routine will cause the terminal buffer that we have been building to be
  111. ! output on the terminal
  112. !--
  113.  
  114. EXTERNAL ROUTINE
  115.     TERM_DUMP : NOVALUE;            ! Output the terminal buffer
  116.  
  117.  
  118. %SBTTL 'Terminal routines -- TT_INIT - Initialize this module'
  119.  
  120. GLOBAL ROUTINE TT_INIT : NOVALUE =
  121.  
  122. !++
  123. ! FUNCTIONAL DESCRIPTION:
  124. !
  125. !    This routine will initialize the terminal processing module.  It will
  126. !    initialize the various data locations in this module.
  127. !
  128. ! CALLING SEQUENCE:
  129. !
  130. !    TT_INIT();
  131. !
  132. ! INPUT PARAMETERS:
  133. !
  134. !    None.
  135. !
  136. ! IMPLICIT INPUTS:
  137. !
  138. !    None.
  139. !
  140. ! OUTPUT PARAMETERS:
  141. !
  142. !    None.
  143. !
  144. ! IMPLICIT OUTPUTS:
  145. !
  146. !    None.
  147. !
  148. ! COMPLETION CODES:
  149. !
  150. !    None.
  151. !
  152. ! SIDE EFFECTS:
  153. !
  154. !    None.
  155. !
  156. !--
  157.  
  158.     BEGIN
  159. !
  160. ! Now initialize the various pointers
  161. !
  162.     TEXT_COUNT = 0;
  163.     TEXT_POINTER = CH$PTR (TEXT_BUFFER);
  164.     DUMP_ROUTINE = TERM_DUMP;            ! Initial output routine is to terminal
  165.     HOLD_FLAG = FALSE;                ! Dump output on CRLF's
  166.     END;                    ! End of TT_INIT
  167.  
  168.  
  169. %SBTTL 'TT_SET_OUTPUT - Set output routine to use'
  170.  
  171. GLOBAL ROUTINE TT_SET_OUTPUT (OUT_RTN) =
  172.  
  173. !++
  174. ! FUNCTIONAL DESCRIPTION:
  175. !
  176. ! This routine will set the output routine to use for the TT_xxx routines.
  177. !The argument is a routine address which will output a counted ASCIZ string.
  178. !It will return the address of the previous output routine.
  179. !
  180. ! CALLING SEQUENCE:
  181. !
  182. !    OLD_RTN = TT_SET_OUTPUT (OUT_RTN);
  183. !
  184. ! INPUT PARAMETERS:
  185. !
  186. !    OUT_RTN - Address of routine to output a counted ASCIZ string
  187. !        called as OUT_RTN (Address of string, length of string)
  188. !
  189. ! IMPLICIT INPUTS:
  190. !
  191. !    DUMP_ROUTINE - Previous output routine
  192. !
  193. ! OUPTUT PARAMETERS:
  194. !
  195. !    The value of the routine is the previous output routine address.
  196. !
  197. ! IMPLICIT OUTPUTS:
  198. !
  199. !    DUMP_ROUTINE - New output routine
  200. !
  201. ! COMPLETION CODES:
  202. !
  203. !    None.
  204. !
  205. ! SIDE EFFECTS:
  206. !
  207. !    None.
  208. !
  209. !--
  210.  
  211.     BEGIN
  212.  
  213.     LOCAL
  214.     OLD_RTN;                ! Old routine address
  215.  
  216.     OLD_RTN = .DUMP_ROUTINE;            ! Remember the old address
  217.     DUMP_ROUTINE = .OUT_RTN;            ! Save the new
  218.     RETURN .OLD_RTN;                ! And return the old value
  219.     END;                    ! End of TT_SET_OUTPUT
  220.  
  221.  
  222. %SBTTL 'TT_HOLD - Start holding text until TT_OUTPUT call'
  223.  
  224. GLOBAL ROUTINE TT_HOLD (FLAG) : NOVALUE =
  225.  
  226. !++
  227. ! FUNCTIONAL DESCRIPTION:
  228. !
  229. !    This routine is called to start buffering an amount of data
  230. !    which should not be output until TT_OUTPUT is called.  It
  231. !    sets a flag to indicate that output should not be done on
  232. !    CRLF's.
  233. !
  234. ! CALLING SEQUENCE:
  235. !
  236. !    TT_HOLD (TRUE or FALSE);
  237. !
  238. ! INPUT PARAMETERS:
  239. !
  240. !    FLAG - True if output should be held past LF's.  False if output
  241. !           should be dumped on each LF.
  242. !
  243. ! IMPLICIT INPUTS:
  244. !
  245. !    None.
  246. !
  247. ! OUPTUT PARAMETERS:
  248. !
  249. !    None.
  250. !
  251. ! IMPLICIT OUTPUTS:
  252. !
  253. !    HOLD_FLAG is set to true.
  254. !
  255. ! COMPLETION CODES:
  256. !
  257. !    None.
  258. !
  259. ! SIDE EFFECTS:
  260. !
  261. !    None.
  262. !
  263. !--
  264.  
  265.     BEGIN
  266.     HOLD_FLAG = .FLAG;
  267.     END;                    ! End of TT_HOLD
  268.  
  269.  
  270. %SBTTL 'Terminal routines -- TT_OUTPUT - Output the buffer'
  271.  
  272. GLOBAL ROUTINE TT_OUTPUT : NOVALUE =
  273.  
  274. !++
  275. ! FUNCTIONAL DESCRIPTION:
  276. !
  277. !    This routine will dump the text buffer on the output device.
  278. !
  279. ! CALLING SEQUENCE:
  280. !
  281. !    TT_OUTPUT();
  282. !
  283. ! INPUT PARAMETERS:
  284. !
  285. !    None.
  286. !
  287. ! IMPLICIT INPUTS:
  288. !
  289. !    None.
  290. !
  291. ! OUTPUT PARAMETERS:
  292. !
  293. !    None.
  294. !
  295. ! IMPLICIT OUTPUTS:
  296. !
  297. !    None.
  298. !
  299. ! COMPLETION CODES:
  300. !
  301. !    None.
  302. !
  303. ! SIDE EFFECTS:
  304. !
  305. !    None.
  306. !
  307. !--
  308.  
  309.     BEGIN
  310.  
  311.     LOCAL
  312.     STATUS;                    ! Status returned by the library routine
  313.  
  314. !
  315. ! Output the text
  316. !
  317.     CH$WCHAR_A (CHR_NUL, TEXT_POINTER);
  318.     (.DUMP_ROUTINE) (TEXT_BUFFER, .TEXT_COUNT);    ! Output the buffer to the correct place
  319. !
  320. ! Now reset the descriptor and the pointer to a virgin state
  321. !
  322.     TEXT_COUNT = 0;
  323.     TEXT_POINTER = CH$PTR (TEXT_BUFFER);
  324. !
  325.     END;                    ! End of TT_OUTPUT
  326.  
  327.  
  328. %SBTTL 'Terminal routines -- TT_CHAR - Output a single character'
  329.  
  330. GLOBAL ROUTINE TT_CHAR (CHARACTER) : NOVALUE =
  331.  
  332. !++
  333. ! FUNCTIONAL DESCRIPTION:
  334. !
  335. !    This routine will store a character into the text buffer.  It will
  336. !    cause the text to be output if the character is a line terminator.
  337. !
  338. ! CALLING SEQUENCE:
  339. !
  340. !    TT_CHAR(Character);
  341. !
  342. ! INPUT PARAMETERS:
  343. !
  344. !    Character - Character to store into the text buffer.
  345. !
  346. ! IMPLICIT INPUTS:
  347. !
  348. !    None.
  349. !
  350. ! OUTPUT PARAMETERS:
  351. !
  352. !    None.
  353. !
  354. ! IMPLICIT OUTPUTS:
  355. !
  356. !    None.
  357. !
  358. ! COMPLETION CODES:
  359. !
  360. !    None.
  361. !
  362. ! SIDE EFFECTS:
  363. !
  364. !    None.
  365. !
  366. !--
  367.  
  368.     BEGIN
  369. !
  370. ! Increment the count of the characters
  371. !
  372.     TEXT_COUNT = .TEXT_COUNT + 1;
  373. !
  374. ! And store the character
  375. !
  376.     CH$WCHAR_A (.CHARACTER, TEXT_POINTER);
  377. !
  378. ! If this is a line feed then just output the text string
  379. !
  380.  
  381.     IF (.CHARACTER EQL CHR_LFD) AND NOT .HOLD_FLAG THEN TT_OUTPUT ();
  382.  
  383. !
  384. ! Check to make sure we are not exceeding the limit of the buffer
  385. !
  386.  
  387.     IF .TEXT_COUNT EQL TEXT_BFR_LENGTH - 1 THEN TT_OUTPUT ();
  388.  
  389. !
  390.     END;                    ! End of TT_CHAR
  391.  
  392.  
  393. %SBTTL 'Terminal routines -- TT_TEXT - Output a text string'
  394.  
  395. GLOBAL ROUTINE TT_TEXT (ADDRESS) : NOVALUE =
  396.  
  397. !++
  398. ! FUNCTIONAL DESCRIPTION:
  399. !
  400. !    This routine will output text on the user's terminal.  It will
  401. !    assume that it must check to determine if it can output the text
  402. !    or not.
  403. !
  404. ! CALLING SEQUENCE:
  405. !
  406. !    TT_TEXT(TEXT_ADDRESS);
  407. !
  408. ! INPUT PARAMETERS:
  409. !
  410. !    None.
  411. !
  412. ! IMPLICIT INPUTS:
  413. !
  414. !    None.
  415. !
  416. ! OUTPUT PARAMETERS:
  417. !
  418. !    None.
  419. !
  420. ! IMPLICIT OUTPUTS:
  421. !
  422. !    None.
  423. !
  424. ! COMPLETION CODES:
  425. !
  426. !    None.
  427. !
  428. ! SIDE EFFECTS:
  429. !
  430. !    None.
  431. !
  432. !--
  433.  
  434.     BEGIN
  435.  
  436.     LOCAL
  437.     CHARACTER,                ! Character being processed
  438.     ARG_POINTER;                ! Pointer to the argument's text
  439.  
  440. !
  441. ! Construct a pointer to the argument.
  442. !
  443.     ARG_POINTER = CH$PTR (.ADDRESS);
  444. !
  445. ! Get the first character that was passed.
  446. !
  447.     CHARACTER = CH$RCHAR_A (ARG_POINTER);
  448. !
  449. ! Loop reading characters and calling the output routine to process
  450. ! them
  451. !
  452.  
  453.     WHILE .CHARACTER NEQ CHR_NUL DO
  454.     BEGIN
  455.     TT_CHAR (.CHARACTER);
  456.     CHARACTER = CH$RCHAR_A (ARG_POINTER);
  457.     END;
  458.  
  459.     END;                    ! End of TT_TEXT
  460.  
  461.  
  462. %SBTTL 'Terminal routines -- TT_NUMBER - Output a three digit number'
  463.  
  464. GLOBAL ROUTINE TT_NUMBER (NUMBER) : NOVALUE =
  465.  
  466. !++
  467. ! FUNCTIONAL DESCRIPTION:
  468. !
  469. !    This routine will store a three digit number into the text buffer.
  470. !    It will just return if the number is greater than 999.
  471. !
  472. ! CALLING SEQUENCE:
  473. !
  474. !    TT_NUMBER(Value);
  475. !
  476. ! INPUT PARAMETERS:
  477. !
  478. !    Value - Value to output.
  479. !
  480. ! IMPLICIT INPUTS:
  481. !
  482. !    None.
  483. !
  484. ! OUTPUT PARAMETERS:
  485. !
  486. !    None.
  487. !
  488. ! IMPLICIT OUTPUTS:
  489. !
  490. !    None.
  491. !
  492. ! COMPLETION CODES:
  493. !
  494. !    None.
  495. !
  496. ! SIDE EFFECTS:
  497. !
  498. !    None.
  499. !
  500. !--
  501.  
  502.     BEGIN
  503.     ROUTINE TT_NUM_WORKER (VALUE) : NOVALUE =
  504.     BEGIN
  505.  
  506.     IF .VALUE LEQ 9
  507.     THEN
  508.         TT_CHAR (.VALUE + %C'0')
  509.     ELSE
  510.         BEGIN
  511.         TT_NUM_WORKER (.VALUE/10);
  512.         TT_CHAR ((.VALUE MOD 10) + %C'0');
  513.         END;
  514.  
  515.     END;
  516.  
  517.     IF .NUMBER LSS 0
  518.     THEN
  519.     BEGIN
  520.     TT_CHAR (%C'-');
  521.     NUMBER = -.NUMBER;
  522.     END;
  523.  
  524.     TT_NUM_WORKER (.NUMBER);
  525.     END;                    ! End of TT_NUMBER
  526.  
  527.  
  528. %SBTTL 'Terminal routines -- TT_CRLF - Output a CRLF'
  529.  
  530. GLOBAL ROUTINE TT_CRLF : NOVALUE =
  531.  
  532. !++
  533. ! FUNCTIONAL DESCRIPTION:
  534. !
  535. !    This routine will cause the contents of the terminal buffer to be
  536. !    output to SYS$OUTPUT:.
  537. !
  538. ! CALLING SEQUENCE:
  539. !
  540. !    TT_CRLF();
  541. !
  542. ! INPUT PARAMETERS:
  543. !
  544. !    None.
  545. !
  546. ! IMPLICIT INPUTS:
  547. !
  548. !    None.
  549. !
  550. ! OUTPUT PARAMETERS:
  551. !
  552. !    None.
  553. !
  554. ! IMPLICIT OUTPUTS:
  555. !
  556. !    None.
  557. !
  558. ! COMPLETION CODES:
  559. !
  560. !    None.
  561. !
  562. ! SIDE EFFECTS:
  563. !
  564. !    None.
  565. !
  566. !--
  567.  
  568.     BEGIN
  569.     TT_CHAR (CHR_CRT);
  570.     TT_CHAR (CHR_LFD);
  571.     END;                    ! End of TT_CRLF
  572.  
  573.  
  574. %SBTTL 'End of KERTRM'
  575. END                        ! End of module
  576.  
  577. ELUDOM
  578.