home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / vmsnet / utilv5_5 < prev    next >
Internet Message Format  |  1993-03-28  |  36KB
  1. Path: uunet!olivea!decwrl!decwrl!waikato.ac.nz!ccc_rex
  2. From: ccc_rex@waikato.ac.nz
  3. Newsgroups: vmsnet.sources.games
  4. Subject: UTIL library source for V5.5
  5. Message-ID: <1993Mar30.134252.15058@waikato.ac.nz>
  6. Date: 30 Mar 93 01:42:52 GMT
  7. Organization: University of Waikato, Hamilton, New Zealand
  8. Lines: 1196
  9. Xref: uunet vmsnet.sources.games:630
  10.  
  11. Hello VMS games players.
  12.  
  13. Here is the UTIL library source fixed to run under VMS V5.5 and later.
  14. It should work with V5.4 back to whenever GETDVI was introduced.
  15.  
  16. Sorry about the bug.  I was using an obsolete system service which seems to
  17. have stopped working.  Remember these programs were written in the early
  18. 1980s!
  19.  
  20. The file TTIO.DIFF is included to show what I changed.  I believe similar
  21. changes have to be made to the MACRO compenent of SNAKE and TANK.
  22.  
  23. Rex Croft       ccc_rex@waikato.ac.nz
  24. VMS Systems Programmer
  25. University of Waikato
  26. Hamilton
  27. New Zealand
  28.  
  29.  
  30. $! ------------------ CUT HERE -----------------------
  31. $ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
  32. $!
  33. $! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
  34. $!   On 30-MAR-1993 13:35:18.27   By user CCC_REX@WAIKATO.AC.NZ
  35. $!
  36. $! This VMS_SHARE Written by:
  37. $!    Andy Harper, Kings College London UK
  38. $!
  39. $! Acknowledgements to:
  40. $!    James Gray       - Original VMS_SHARE
  41. $!    Michael Bednarek - Original Concept and implementation
  42. $!
  43. $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
  44. $! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
  45. $!
  46. $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
  47. $!       1. IMAGEDIR.MAR;6
  48. $!       2. SLEEP.MAR;1
  49. $!       3. TTIO.DIFF;1
  50. $!       4. TTIO.MAR;49
  51. $!       5. UTIL.COM;3
  52. $!
  53. $set="set"
  54. $set symbol/scope=(nolocal,noglobal)
  55. $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
  56. $e="write sys$error  ""%UNPACK"", "
  57. $w="write sys$output ""%UNPACK"", "
  58. $ if f$trnlnm("SHARE_LOG") then $ w = "!"
  59. $ ve=f$getsyi("version")
  60. $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
  61. $ e "-E-OLDVER, Must run at least VMS 4.4"
  62. $ v=f$verify(v)
  63. $ exit 44
  64. $UNPACK: SUBROUTINE ! P1=filename, P2=checksum
  65. $ if f$search(P1) .eqs. "" then $ goto file_absent
  66. $ e "-W-EXISTS, File ''P1' exists. Skipped."
  67. $ delete 'f'*
  68. $ exit
  69. $file_absent:
  70. $ if f$parse(P1) .nes. "" then $ goto dirok
  71. $ dn=f$parse(P1,,,"DIRECTORY")
  72. $ w "-I-CREDIR, Creating directory ''dn'."
  73. $ create/dir 'dn'
  74. $ if $status then $ goto dirok
  75. $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
  76. $ delete 'f'*
  77. $ exit
  78. $dirok:
  79. $ w "-I-PROCESS, Processing file ''P1'."
  80. $ if .not. f$verify() then $ define/user sys$output nl:
  81. $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
  82. PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
  83. SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
  84. CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
  85. LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
  86. BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
  87. IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
  88. MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
  89. ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
  90. 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
  91. POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
  92. ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
  93. COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
  94. "output_file"));ENDPROCEDURE;Unpacker;QUIT;
  95. $ delete/nolog 'f'*
  96. $ CHECKSUM 'P1'
  97. $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
  98. $ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
  99. $ ENDSUBROUTINE
  100. $START:
  101. $ create 'f'
  102. X`09.title`09imagedir`09find directory image was run from
  103. X
  104. X;+
  105. X;`09Modified 25-Jul-1985 to handle VMS V4 rooted directory specs
  106. X;-
  107. X
  108. X`09$jpidef
  109. X
  110. X`09.psect`09$code4`09rd, nowrt, exe, rel, pic, con, shr, long
  111. X
  112. Xlog:`09.ascii`09'IMAGE_DIR'
  113. Xlog_len = . - log
  114. X
  115. X`09.align`09word
  116. X`09.entry`09-
  117. Ximage_dir, `5Em<r2,r3,r4,r5>
  118. X;+
  119. X;`09status = image_dir()
  120. X;
  121. X;`09assigns the disk and directory that the current image is stored in
  122. X;`09to the logical "image_dir"
  123. X;
  124. X;`09status`09system service status code
  125. X;-
  126. X`09moval`09-(sp), r4`09`09; address of return length
  127. X`09subl2`09#256, sp`09`09; allocate room for image name
  128. X`09movl`09sp, r3`09`09`09; remember its address
  129. X
  130. X`09pushl`09#0`09`09`09; end of item list
  131. X`09pushl`09r4`09`09`09; return length address
  132. X`09pushl`09r3`09`09`09; buffer address
  133. X`09pushl`09#256!<jpi$_imagname@16> ; length and item code
  134. X`09movl`09sp, r1`09`09`09; address of item list
  135. X
  136. X`09$getjpi_s itmlst=(r1)`09`09; get info for this process
  137. X`09blbc`09r0, 1000$`09`09; br if error
  138. X
  139. X`09subl2`09#4*4, sp`09`09; remove item list from stack
  140. X;+
  141. X;`09now search for end of directory name ("`5D" or ">")
  142. X;-
  143. X`09movzwl`09(r4), r4`09`09; get full length of image name
  144. X`09movl`09r3, r5`09`09`09; get address
  145. X10$:
  146. X`09locc`09#`5EA/:/, r4, (r5)`09; look for end of logical name
  147. X`09beql`0920$`09`09`09; br if not found
  148. X
  149. X`09subl3`09#1, r0, r4`09`09; get new length
  150. X`09addl3`09#1, r1, r5`09`09; get new address
  151. X`09brb`0910$`09`09`09; look for another colon
  152. X20$:
  153. X`09locc`09#`5EA/`5D/, r4, (r5)`09; find closing bracket
  154. X`09beql`0940$`09`09`09; br if not found
  155. X
  156. X`09subl3`09#1, r0, r4`09`09; get new length
  157. X`09addl3`09#1, r1, r5`09`09; get new address
  158. X`09brb`0920$`09`09`09; look for another "`5D"
  159. X40$:
  160. X`09locc`09#`5EA/>/, r4, (r5)`09; find closing bracket
  161. X`09beql`0960$`09`09`09; br if not found
  162. X
  163. X`09subl3`09#1, r0, r4`09`09; get new length
  164. X`09addl3`09#1, r1, r5`09`09; get new address
  165. X`09brb`0940$`09`09`09; look for another ">"
  166. X60$:
  167. X
  168. X100$:
  169. X`09pushl`09r3`09`09`09; address of eqlnam
  170. X`09subl3`09r3, r5, -(sp)`09`09; get length of eqlnam
  171. X`09movl`09sp, r2`09`09`09; save address of descriptor
  172. X
  173. X`09pushab`09W`5Elog`09`09`09; address of lognam
  174. X`09pushl`09#log_len`09`09; length of lognam
  175. X`09movl`09sp, r3`09`09`09; save address of descriptor
  176. X
  177. X`09$crelog_s tblflg=#2, lognam=(r3), eqlnam=(r2) ; create process logical
  178. X;`09blbc`09r0, 1000$`09`09; br if error
  179. X1000$:
  180. X`09ret`09`09`09`09; which will clean up the stack
  181. X
  182. X
  183. X`09.end
  184. $ CALL UNPACK IMAGEDIR.MAR;6 173433367
  185. $ create 'f'
  186. X`09.title`09SLEEP - delay for specified interval
  187. X`09$ssdef`09`09`09; want ss$_insfarg
  188. X`09.psect`09$code`09pic, shr, rd, nowrt, exe
  189. X`09.entry`09-
  190. Xsleep, `5Em<r2, r3>
  191. X; Subroutine Sleep(Seconds, Fraction)
  192. X; Integer*4 Seconds, Fraction
  193. X`09seconds = 4`09`09; param offset
  194. X`09fraction = 8`09`09; optional fraction, in 100 ns units
  195. X`09sleep_efn = 0`09`09; which event flag to use
  196. X`09cmpb`09(ap), #1`09; how many args?
  197. X`09beqlu`092100$
  198. X`09bgtru`092200$
  199. X`09movl`09#ss$_insfarg, r0 ; none - error
  200. X`09brb`099000$
  201. X2100$:`09clrl`09r1`09`09; one arg, so fraction part is zero
  202. X`09brb`092900$
  203. X2200$:`09mnegl`09@fraction(ap), r1 ; else get fraction part
  204. X2900$:`09mnegl`09@seconds(ap), r0 ; make negative
  205. X`09emul`09#10000000, r0, r1, r2`09; convert to proper units in r2, r3
  206. X`09movq`09r2, -(sp)`09; push time onto stack
  207. X`09movaq`09(sp), r2`09; remember address
  208. X`09$setimr_s-`09`09; set timer
  209. X`09`09efn=#sleep_efn,-
  210. X`09`09daytim=(r2)`09; address of time value
  211. X`09blbc`09r0, 9000$
  212. X`09$waitfr_s-`09`09; wait for timer
  213. X`09`09efn=#sleep_efn
  214. X9000$:`09ret`09`09`09; done
  215. X
  216. X`09.end
  217. $ CALL UNPACK SLEEP.MAR;1 1182597876
  218. $ create 'f'
  219. X************
  220. XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;46
  221. X  210   `09$dvidef
  222. X  211   `09$iodef`09`09; qio io$_...
  223. X******
  224. XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;43
  225. X  210   `09$dibdef
  226. X  211   `09$iodef`09`09; qio io$_...
  227. X************
  228. X************
  229. XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;46
  230. X  231   mbxitmlst:
  231. X  232   `09.word`09mbxname_len, dvi$_devnam
  232. X  233   `09.address mbxname
  233. X  234   `09.address mbxiosb`09`09; return length, don't want
  234. X  235   `09.long`090`09`09`09; end of list
  235. X  236  `20
  236. X******
  237. XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;43
  238. X  231   dibbuf_descr:
  239. X  232   `09.word`09dib$k_length, 0
  240. X  233   `09.address dibbuf
  241. X  234  `20
  242. X************
  243. X************
  244. XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;46
  245. X  241   mbxname_len = 64
  246. X  242   mbxname:`09`09`09; room to hold the physical mbx name
  247. X******
  248. XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;43
  249. X  239   mbxname_len = 16
  250. X  240   mbxname:`09`09`09; room to hold the physical mbx name
  251. X************
  252. X************
  253. XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;46
  254. X  253   `09.align`09long
  255. X******
  256. XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;43
  257. X  251   dibbuf:
  258. X  252   `09.blkb`09dib$k_length
  259. X  253  `20
  260. X  254   `09.align`09long
  261. X************
  262. X************
  263. XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;46
  264. X  359  `20
  265. X  360   ;`09$getchn_s`09chan=mbxchan, pribuf=dibbuf_descr
  266. X  361   ;`09bsbw`09`09error
  267. X  362   ;`09$fao_s`09`09ctrstr=mbxcnv, outbuf=mbxname_descr,-
  268. X  363   ;`09`09`09outlen=mbxname_descr, p1=dibbuf+dib$w_unit
  269. X  364  `20
  270. X  365   `09$getdvi_s`09chan=mbxchan, itmlst=mbxitmlst
  271. X  366   `09bsbw`09`09error
  272. X  367   `09locc`09`09#0, #mbxname_len, mbxname  ; find trailing nulls
  273. X  368   `09subl3`09`09r0, #mbxname_len, r0
  274. X  369   `09movw`09`09r0, mbxname_descr`09; store length of name
  275. X  370  `20
  276. X  371   `09$assign_s`09devnam=ttname_descr, chan=ttchan, acmode=#`5ExFF00,-
  277. X******
  278. XFile CCC_:`5BREX.UTIL`5DTTIO.MAR;43
  279. X  360   `09$getchn_s`09chan=mbxchan, pribuf=dibbuf_descr
  280. X  361   `09bsbw`09`09error
  281. X  362   `09$fao_s`09`09ctrstr=mbxcnv, outbuf=mbxname_descr,-
  282. X  363   `09`09`09outlen=mbxname_descr, p1=dibbuf+dib$w_unit
  283. X  364   `09$assign_s`09devnam=ttname_descr, chan=ttchan, acmode=#`5ExFF00,-
  284. X************
  285. X
  286. XNumber of difference sections found: 5
  287. XNumber of difference records found: 22
  288. X
  289. XDIFFERENCES /IGNORE=()/MERGED=1/OUTPUT=CCC_:`5BREX.UTIL`5DTTIO.DIFF;1-
  290. X    CCC_:`5BREX.UTIL`5DTTIO.MAR;46-
  291. X    CCC_:`5BREX.UTIL`5DTTIO.MAR;43
  292. $ CALL UNPACK TTIO.DIFF;1 1664959250
  293. $ create 'f'
  294. X`09.title`09TTIO`09Terminal IO routines ($QIO's)
  295. X;+
  296. X;`09Routines to do IO via $QIO's to get special features.
  297. X;-
  298. X.if ne 0
  299. X1 TTIO
  300. XThis is a group of routines to enable you to perform efficient/special
  301. Xinput and/or output to a terminal.
  302. X2 TT_INIT
  303. XCALL TT_INIT( type )
  304. X
  305. X"type" is an integer variable which indicates the input you wish.
  306. X
  307. X"type" = 0  ordinary line input
  308. X         1  efficient single character input if available
  309. X         2  line input with escape sequences
  310. X2 TT_SET_FUNC
  311. XSets the read function modifiers and the wait time.  Once set, the options
  312. Xwill stay in effect until changed.
  313. X
  314. XINTEGER TT_SET_FUNC
  315. X
  316. XI = TT_SET_FUNC( value `5B, seconds `5D )
  317. X
  318. X"value" is a bit encoded integer specifying options required
  319. X  Symbol      Hex value         Description
  320. XIO$M_NOFILTR   '0200'X  Ctrl/U, Ctrl/R or Delete are passed to the user
  321. XIO$M_PURGE     '0800'X  Type-ahead buffer is purged before the read
  322. XIO$M_TIMED     '0080'X  Read must complete within specified time
  323. XIO$M_TRMNOECHO '1000'X  The terminator character (if any) is not echoed
  324. X
  325. X"seconds"  maximum time a read may take in seconds
  326. X"I" is the IO completion status code
  327. X2 TT_SET_READF
  328. XSets the buffer address and length before calling TT_SET_READF.
  329. X
  330. XINTEGER FUNCTION TT_SET_READF( buffer, buf_len )
  331. X
  332. Xbuffer`09address of buffer or address of descriptor of buffer
  333. Xbuf_len length of buffer.  If omitted then "buffer" is a descriptor
  334. X
  335. XValue of function is the I/O status completion code
  336. X2 TT_SET_TERM
  337. XSet terminator character mask
  338. X
  339. XCALL TT_SET_TERM( option, parameters... )
  340. X
  341. Xoption
  342. X  0`09normal terminators (any control char except LF VT FF TAB BS
  343. X  1`09parameter 1 is the address of a longword containing the
  344. X   `09terminator bit mask (first 32 characters only)
  345. X   `09eg. CALL TT_SET_TERM( 1, '00000001'X )
  346. X   `09    enable Control A as terminator
  347. X  2`09parameter 1 is address of # of bytes in terminator mask
  348. X   `09parameter 2 is address of array containing terminator bit mask
  349. X  3`09the following parameters are addresses of a byte containing
  350. X   `09the acsii code of the character to be a terminator.
  351. X   `09eg. CALL TT_SET_TERM( 3, 10, 13 )
  352. X   `09    enable LF and CR to be terminators
  353. X2 TT_CTRLCAST
  354. X
  355. XCALL TT_CTRLCAST( subroutine )
  356. X
  357. XThis causes the next control C to call the named routine.
  358. X2 TT_1_CHAR
  359. XINTEGER TT_1_CHAR
  360. X
  361. XI = TT_1_CHAR()
  362. X
  363. X"I" contains the ascii value of the character typed.
  364. XThis routine waits for the character and then returns it.
  365. XWhatever options that are set (see TT_SET_OPTION) are applied. (not true)
  366. X2 TT_1_CHAR_T
  367. XINTEGER TT_1_CHAR_T
  368. X
  369. XI = TT_1_CHAR_T( seconds )
  370. X
  371. XThis routine reads 1 character if typed within "seconds" time.
  372. X"I" contains the ascii value of the character typed,
  373. X it is 0 if the read timed out.
  374. X2 TT_1_CHAR_NOW
  375. XINTEGER TT_1_CHAR_NOW
  376. X
  377. XI = TT_1_CHAR_NOW()
  378. X
  379. X"I" contains the ascii value of the character typed, or -1 if no
  380. Xcharacter is available.  The character is not echoed.
  381. XThis routine returns immediately.
  382. X2 TT_READ
  383. XThis routine reads a line from the terminal.
  384. X
  385. XINTEGER TT_READ
  386. XI = TT_READ( buffer, buf_len, data_len `5B, term_len `5D )
  387. X  or
  388. XI = TT_READ( buf_desc, , data_len `5B, term_len `5D )
  389. X
  390. X"buffer" is the address of the input buffer
  391. X"buf_len" is the length of the input buffer in bytes
  392. X"data_len" will contain the number of characters read
  393. X"term_len" (if specified) will contain the length of the terminator
  394. X"I" will contain the IO completion status code
  395. X
  396. X"buf_desc" is the address of a descriptor of the input buffer
  397. X
  398. X2 TT_READF
  399. X
  400. XINTEGER FUNCTION TT_READF( data_len )
  401. Xdata_len length of data read (# of characters) (not including term)
  402. X
  403. XThis routine is used for reading a lot of data (presumably with
  404. Xecho reset). READF stands for READ FAST.
  405. XTT_READF_SET must be called first.
  406. X
  407. XValue of function is the I/O status completion code
  408. X2 TT_PROMPT
  409. XThis routine reads a line from the terminal.
  410. X
  411. XINTEGER TT_PROMPT
  412. XI = TT_PROMPT( prompt, prompt_len, buffer, buf_len, data_len
  413. X`09`09`09`09`09`09`5B, term_len `5D )
  414. X  or
  415. XI = TT_PROMPT( prompt_desc, , buf_desc, , data_len `5B, term_len `5D )
  416. X
  417. X"prompt" is the address of a character string
  418. X"prompt_len" is the length of the prompt character string
  419. X"buffer" is the address of the input buffer
  420. X"buf_len" is the length of the input buffer in bytes
  421. X"data_len" will contain the number of characters read
  422. X"term_len" (if specified) will contain the length of the terminator
  423. X"I" will contain the IO completion status code
  424. X
  425. X"prompt_desc" is the address of a descriptor of the prompt string
  426. X"buf_desc" is the address of a descriptor of the input buffer
  427. X
  428. X2 TT_WRITE
  429. XCALL TT_WRITE( array, length )
  430. XINTEGER length
  431. XBYTE array( length )
  432. X
  433. X"array" is the address of the characters
  434. X"length" is the number of characters to write
  435. X
  436. XThe write is done in "noformat" (binary) mode.  This completely bypasses
  437. Xany checking done by the terminal driver eg. for tabs, escape sequences,
  438. Xor end of line wrapping. `20
  439. X2 TT_WRITE_S
  440. XCALL TT_WRITE( array, length, efn )
  441. XINTEGER length, efn
  442. XBYTE array( length )
  443. X
  444. X"array" is the address of the characters
  445. X"length" is the number of characters to write
  446. X"efn" is the efn which will be set upon the writes completion
  447. X`09This routine does not wait for it to be set.
  448. X
  449. XCan be called synchronously with TT_WRITE.
  450. XThis is so that you can do 2 writes at the same time.
  451. XIt is designed for use within an AST procedure.
  452. X2 TT_CANCEL
  453. XCALL TT_CANCEL
  454. X
  455. XCancels type-ahead.
  456. X2 TT_CANCEL_IO
  457. XCALL TT_CANCEL_IO
  458. X
  459. XCancels all pending I/O requests that were issued via the TTIO routines.
  460. XThis will normally be called from within an AST procedure.
  461. X2 Examples
  462. XC`09TEST TTIO ROUTINES
  463. XC
  464. X`09INTEGER TT_PROMPT
  465. X`09CHARACTER PROMPT*16, BUF_IN*80
  466. X`09DATA PROMPT / 'ABCDEFGHIJKLMNO>' /
  467. XC
  468. X`09CALL TT_INIT( 2 )
  469. XC
  470. X`09DO J=1,10
  471. X`09  I = TT_PROMPT( PROMPT, , BUF_IN, , LEN_IN , LEN_TERM )
  472. X`09  TYPE *,I,LEN_IN, LEN_TERM
  473. X`09  TYPE *,BUF_IN(:LEN_IN)`09! THE TERMINATOR IS AFTER THIS
  474. X`09END DO
  475. X`09END
  476. X1 SLEEP_SET
  477. XThis routine, along with SLEEP_START and SLEEP_WAIT, allows your program
  478. Xto execute an asynchronous sleep.  You call SLEEP_SET to specify the length
  479. Xof time.  Then you call SLEEP_START to begin the timed period.  Control
  480. Xreturns immediately to your image; you can then execute whatever code is
  481. Xrequired.  Then you call SLEEP_WAIT to wait for the timed period to expire.
  482. XThe timed period may have already finished, in which case control will
  483. Xreturn immediately.
  484. X2 Parameters
  485. XCALL SLEEP_SET( time , efn )
  486. X
  487. X"time" is the address of an integer specifying the timed period in
  488. X       hundredths of a second.
  489. X"efn"  is the address of an integer indicating which event flag to use.
  490. X       Use 21 if you have no preference.  Must be less than 24.
  491. X1 SLEEP_START
  492. XThis starts a timed period, as specified by the previous call to SLEEP_SET.
  493. X
  494. XCALL SLEEP_START
  495. X
  496. XControl returns immediately.
  497. X1 SLEEP_WAIT
  498. XThis waits for the completion of a timed period, as started by the previous
  499. Xcall to SLEEP_START
  500. X
  501. XCALL SLEEP_WAIT
  502. X.endc
  503. X`09$dvidef
  504. X`09$iodef`09`09; qio io$_...
  505. X`09$ttdef`09`09; terminal characteristics
  506. X
  507. X
  508. X`09.psect`09$rw_TT_channel$ wrt, rd, noexe, noshr, pic, long
  509. Xttchan:
  510. X`09.long`09; channel on which terminal is open (if non zero)
  511. X
  512. X`09.psect`09tt$rodata`09nowrt, noexe, shr, pic, long
  513. X
  514. Xttname_descr:
  515. X`09.ascid`09/TT/
  516. X
  517. Xmbxcnv:
  518. X`09.ascid`09/_MBA!UW:/`09; convert mbx unit number to physical name
  519. X
  520. Xmbxbuf_descr:
  521. X`09.word`09mbxbuf_siz, 0
  522. X`09.address mbxbuf
  523. X
  524. Xmbxitmlst:
  525. X`09.word`09mbxname_len, dvi$_devnam
  526. X`09.address mbxname
  527. X`09.address mbxiosb`09`09; return length, don't want
  528. X`09.long`090`09`09`09; end of list
  529. X
  530. X`09.align long
  531. X
  532. X`09.psect`09tt$rwbuf`09wrt, noexe, noshr, pic, long
  533. X
  534. Xmbxname_len = 64
  535. Xmbxname:`09`09`09; room to hold the physical mbx name
  536. X`09.blkb`09mbxname_len
  537. Xmbxname_descr:
  538. X`09.word`09mbxname_len, 0
  539. X`09.address mbxname
  540. Xmbxiosb:
  541. X`09.long`090,0
  542. Xmbxbuf_siz = 32
  543. Xmbxbuf:
  544. X`09.blkb`09mbxbuf_siz
  545. X
  546. X`09.align`09long
  547. Xttbuf_siz = 128
  548. Xttbuf:
  549. X`09.blkb`09ttbuf_siz
  550. X;outbuf_siz = 128
  551. X;outbuf::
  552. X;`09.blkb`09outbuf_siz
  553. X
  554. Xttiosb:
  555. X`09.long`090,0
  556. Xtt_func:
  557. X`09.long`09io$_readvblk
  558. Xtt_p_func:
  559. X`09.long`09io$_readprompt
  560. Xtt_timed:
  561. X`09.long`09`09`09; wait time if specified
  562. Xtt_term_addr:
  563. X`09.long`09`09`09; p4 parameter of read
  564. Xtt_term_quad:
  565. X`09.quad`09`09`09; quad word pointed to be tt_term_addr
  566. Xtt_term_mask:
  567. X`09.blkb`0916`09`09; bit set if that char is a terminator (0-127)
  568. X
  569. X
  570. X`09.psect`09tt$rwdata`09wrt, noexe, noshr, pic, long
  571. X
  572. Xmbxchan:
  573. X`09.word
  574. Xdata_ready:
  575. X`09.word
  576. X
  577. Xchars_left:
  578. X`09.long
  579. Xchar_pointer:
  580. X`09.long
  581. X
  582. Xsleep_time:
  583. X`09.long -100000*30, -1`09`09; time to sleep (30/100ths default)
  584. X
  585. Xttmode:`09`09`09`09`09; terminal chars changed
  586. X`09.quad
  587. Xttsavemode:`09`09`09`09; original terminal characteristics
  588. X`09.quad
  589. X
  590. Xsleep_args:
  591. X`09.long`094
  592. Xsleep_efn:
  593. X`09.long`0921`09; event flag to use for sleeps
  594. X`09.address sleep_time
  595. X`09.long`090`09; astadr
  596. X`09.long`090`09; reqidt
  597. X
  598. X;outbuf_qio:
  599. X;`09$qio`09func=io$_writevblk!io$m_noformat,-
  600. X;`09`09p1=outbuf
  601. Xoutput_qio:
  602. X`09$qio`09func=io$_writevblk!io$m_noformat
  603. X
  604. Xread_now_qio:
  605. X`09$qio`09func=io$_readvblk!io$m_timed!io$m_noecho!io$m_nofiltr,-
  606. X`09`09iosb=ttiosb,-
  607. X`09`09p1=ttbuf, p2=ttbuf_siz, p3=0`09; wait time = 0
  608. X
  609. Xread_fast_qio:`09; inittialized by TT_SET_READF
  610. X`09$qio`09func=io$_ttyreadall!io$m_noecho, iosb=ttiosb
  611. X
  612. Xtt_exit_blk:`09`09`09; exit handler block
  613. X`09.long
  614. X`09.address tt_exit_handler
  615. X`09.long`091`09`09; 1 argument
  616. X`09.address 10$
  617. X10$:`09.long`090`09`09; exit reason
  618. X
  619. X
  620. X`09.psect`09tt$code  nowrt, exe, shr, pic, long
  621. X
  622. X`09.entry`09-
  623. XTT_INIT, `5Em<r2>
  624. X;+
  625. X; CALL TT_INIT( type )
  626. X; type`09= 0, ordinary line input
  627. X;`09  1, single character input
  628. X;`09  2, line input with escape sequences
  629. X;
  630. X;`09patch 16-Sep-1982
  631. X;`09`09Only allow 1 call to TT_INIT
  632. X;-
  633. X`09tstw`09ttchan`09`09; if channel already allocated, return
  634. X`09beql`0950$`09`09; patch 16-Sep-1982
  635. X`09ret
  636. X50$:
  637. X`09movl`09@4(ap), r2`09; get type code
  638. X
  639. X`09caseb`09r2, #0, #2
  640. X20$:`09.word`09100$-20$
  641. X`09.word`09200$-20$
  642. X`09.word`09300$-20$
  643. X100$:`09; type 0 (line input)
  644. X`09$assign_s`09devnam=ttname_descr, chan=ttchan
  645. X`09bsbw`09error`09`09`09; check for error
  646. X`09brw`091000$
  647. X
  648. X200$:`09; type 1 (single character input)
  649. X; Create a mailbox.  Assign a channel to terminal with an associated mailbox
  650. V.
  651. X`09$crembx_s`09chan=mbxchan, promsk=#`5ExFF00
  652. X`09bsbw`09`09error
  653. X
  654. X;`09$getchn_s`09chan=mbxchan, pribuf=dibbuf_descr
  655. X;`09bsbw`09`09error
  656. X;`09$fao_s`09`09ctrstr=mbxcnv, outbuf=mbxname_descr,-
  657. X;`09`09`09outlen=mbxname_descr, p1=dibbuf+dib$w_unit
  658. X
  659. X`09$getdvi_s`09chan=mbxchan, itmlst=mbxitmlst
  660. X`09bsbw`09`09error
  661. X`09locc`09`09#0, #mbxname_len, mbxname  ; find trailing nulls
  662. X`09subl3`09`09r0, #mbxname_len, r0
  663. X`09movw`09`09r0, mbxname_descr`09; store length of name
  664. X
  665. X`09$assign_s`09devnam=ttname_descr, chan=ttchan, - ; acmode=#`5ExFF00
  666. X`09`09`09mbxnam=mbxname_descr`09; acmode fails in VMS 5.5
  667. X`09bsbw`09error
  668. X`09bsbw`09queue_mbxread`09`09; start mail box read
  669. X`09brw`091000$
  670. X
  671. X300$:`09; type 2 (line input with escape sequences)
  672. X`09$assign_s`09devnam=ttname_descr, chan=ttchan
  673. X`09bsbw`09error`09`09`09; check for error
  674. X`09$qiow_s func=#io$_sensemode, chan=ttchan, -
  675. X`09`09iosb=ttiosb, p1=ttmode`09; get terminal characteristics
  676. X`09bsbw`09error
  677. X`09movzwl`09ttiosb, r0
  678. X`09bsbw`09error
  679. X`09movq`09ttmode, ttsavemode`09; save current terminal chars
  680. X`09$dclexh_s desblk=tt_exit_blk`09; declare exit handler to restore
  681. X`09`09`09`09`09; terminal chars on exit.
  682. X`09bsbw`09error
  683. X`09bbss`09#tt$v_escape, ttmode+4, 310$`09; want escape sequences
  684. X310$:`09$qiow_s func=#io$_setmode, chan=ttchan, -
  685. X`09`09iosb=ttiosb, p1=ttmode
  686. X`09bsbw`09error
  687. X`09movzwl`09ttiosb, r0
  688. X`09bsbw`09error
  689. X;`09brbw`091000$
  690. X
  691. X1000$:
  692. X;`09movw`09ttchan, outbuf_qio+qio$_chan`09`09;store channel #
  693. X`09movw`09ttchan, output_qio+qio$_chan`09`09;store channel #
  694. X`09movw`09ttchan, read_now_qio+qio$_chan`09`09;store channel #
  695. X;`09$qiow_s`09func=#io$_setmode!io$m_ctrlcast, chan=ttchan,-
  696. X;`09`09p1=control_c`09`09`09; set control C trap
  697. X`09ret
  698. X
  699. X
  700. X`09.entry`09-
  701. XTT_SET_FUNC, `5Em<>
  702. X;+
  703. X;`09I = TT_SET_FUNC( value `5B, seconds `5D )
  704. X;`09set read modifiers
  705. X;-
  706. X`09movl`09@4(ap), r0`09`09`09; get modifiers
  707. X`09movl`09#io$m_nofiltr!io$m_purge!io$m_timed!io$m_trmnoecho, r1
  708. X`09`09`09`09`09; get bits allowed to set
  709. X`09bicl2`09r1, tt_func`09`09; clear previous options
  710. X`09bicl2`09r1, tt_p_func
  711. X`09mcoml`09r1, r1`09`09`09; get bits cannot change
  712. X`09bicl2`09r1, r0`09`09`09; make sure only change correct bits
  713. X`09bisl2`09r0, tt_func`09`09; and set new options
  714. X`09bisl2`09r0, tt_p_func
  715. X
  716. X`09cmpb`09#1, (ap)`09`09; check if "seconds" parameter here
  717. X`09bgtr`09100$
  718. X`09ret
  719. X100$:`09movl`09@8(ap), tt_timed`09; store time
  720. X`09ret
  721. X
  722. X
  723. X`09.entry`09-
  724. XTT_SET_TERM, `5Em<r2,r3>
  725. X;+
  726. X;`09CALL TT_SET_TERM( option, parameters... )
  727. X;`09set terminator character mask
  728. X;
  729. X;`09option
  730. X;`090`09normal terminators (any control char except LF VT FF TAB BS
  731. X;`091`09parameter 1 is the address of a longword containing the
  732. X;`09`09terminator bit mask (first 32 characters only)
  733. X;`09`09( 1, '00000001'X )`09! enable Control A as terminator
  734. X;`092`09parameter 1 is address of # of bytes in terminator mask
  735. X;`09`09parameter 2 is address of array containing terminator bit mask
  736. X;`093`09the following parameters are addresses of a byte containing
  737. X;`09`09the acsii code of the character to be a terminator.
  738. X;`09`09( 3, 10, 13 )`09`09! enable LF and CR to be terminators
  739. X;-
  740. X`09subl3`09#1, (ap)+, r0`09`09; get number of parameters - 1
  741. X`09movl`09@(ap)+, r1`09`09; get option
  742. X
  743. X`09caseb`09r1, #0, #3
  744. X10$:`09.word`09100$-10$
  745. X`09.word`09200$-10$
  746. X`09.word`09300$-10$
  747. X`09.word`09400$-10$
  748. X; fall thru to option 0
  749. X100$:
  750. X`09clrl`09tt_term_addr`09`09; 0 means the default term mask
  751. X`09ret
  752. X200$:`09; option 1
  753. X`09sobgeq`09r0, 210$`09`09; see if another parameter
  754. X`09ret
  755. X210$:`09movl`09@(ap)+, r3`09`09; get longword terminator mask
  756. X240$:`09; r3 contains low 32 bits of terminator mask
  757. X`09clrl`09r2`09`09`09; first longword must be zero
  758. X`09movq`09r2, tt_term_quad`09; store it
  759. X250$:`09movaq`09tt_term_quad, tt_term_addr ; set up pointer to quadword
  760. X`09ret
  761. X
  762. X300$:`09; option 2`09; param1 is # of bytes`09; param2 if address of bytes
  763. X`09sobgeq`09r0, 310$`09`09; see if another parameter
  764. X`09ret
  765. X310$:`09movzbl`09@(ap)+, tt_term_quad`09; store # of bytes in term mask
  766. X`09sobgeq`09r0, 320$`09`09; see if another parameter
  767. X`09ret
  768. X320$:`09movl`09@(ap)+, tt_term_quad+4`09; store address of term bit mask
  769. X`09brb`09250$`09`09`09; go set up pointer and exit
  770. X
  771. X400$:`09; option 3`09; a list of ascii codes follow
  772. X`09movab`09tt_term_mask, r3`09; base of terminator bit mask
  773. X`09movl`09r3, r1
  774. X`09clrq`09(r1)+`09`09`09; zero terminator bit mask
  775. X`09clrq`09(r1)+`09`09`09; 16 bytes (0-127)
  776. X`09clrq`09(r1)+
  777. X`09clrq`09(r1)+
  778. X`09clrl`09r1`09`09`09; maximum ascii code
  779. X`09clrl`09r2`09`09`09; we put ascii code in low byte
  780. X`09tstl`09r0`09`09`09; see if at least 1 parameter
  781. X`09bgtr`09410$
  782. X`09ret
  783. X410$:
  784. X`09bicb3`09#`5EX80, @(ap)+, r2`09; get ascii code (0-127)
  785. X`09cmpl`09r2, r1`09`09`09; bigger than previous maximum ?
  786. X`09bleq`09420$
  787. X`09movl`09r2, r1
  788. X420$:`09bbss`09r2, (r3), 440$`09`09; set bit
  789. X440$:`09sobgtr`09r0, 410$`09`09; do all parameters
  790. X
  791. X`09addl2`09#7, r1`09`09`09; round up to nearest byte
  792. X`09divl2`09#8, r1`09`09`09; get # of bytes in term mask
  793. X`09cmpl`09r1, #4`09`09`09; if <= 4 bytes, use short format
  794. X`09bgtr`09450$
  795. X`09movl`09(r3), r3`09`09; get first 4 bytes of mask in r3
  796. X`09brw`09240$`09`09`09; go store it and pointer and exit
  797. X450$:
  798. X`09movl`09r1, tt_term_quad`09; store # of bytes for long format
  799. X`09movl`09r3, tt_term_quad+4`09; store address of term bit mask
  800. X`09brb`09250$`09`09`09; store pointer and exit
  801. X
  802. X
  803. X
  804. X`09.entry`09-
  805. XTT_CTRLCAST,`09`5Em<>
  806. X;+
  807. X;`09CALL TT_CTRLCAST( routine address )
  808. X;`09enable a control C ast
  809. X;-
  810. X`09$qiow_s func=#io$_setmode!io$m_ctrlcast, chan=ttchan, iosb=ttiosb, -
  811. X`09`09p1=@4(ap)
  812. X`09ret`09`09`09`09; ignore all erros
  813. X
  814. X
  815. X`09.entry`09-
  816. XTT_1_CHAR,`09`5Em<>
  817. X;+
  818. X;`09I = TT_1_CHAR
  819. X;`09read 1 character.  Waits for it.
  820. X;-
  821. X`09clrb`09ttbuf
  822. X`09$qiow_s`09func=#io$_readvblk!io$m_noecho!io$m_nofiltr,-
  823. X`09`09chan=ttchan, iosb=ttiosb,-
  824. X`09`09p1=ttbuf, p2=#1
  825. X`09cvtbl`09ttbuf, r0
  826. X`09ret
  827. X
  828. X`09.entry`09-
  829. XTT_1_CHAR_T,`09`5Em<>
  830. X;+
  831. X;`09I = TT_1_CHAR_T( seconds )
  832. X;`09read 1 character.  Waits "seconds" for it.
  833. X;`09returns 0 if times out
  834. X;-
  835. X`09clrb`09ttbuf
  836. X`09$qiow_s`09func=#io$_readvblk!io$m_noecho!io$m_nofiltr!io$m_timed,-
  837. X`09`09chan=ttchan, iosb=ttiosb,-
  838. X`09`09p1=ttbuf, p2=#1, p3=@4(ap)
  839. X`09cvtbl`09ttbuf, r0
  840. X`09ret
  841. X
  842. X`09.entry`09-
  843. XTT_1_CHAR_NOW, `5Em<>
  844. X;+
  845. X;`09I = TT_1_CHAR_NOW()
  846. X;`09get next character if typed.  Returns immediately.
  847. X;`09I = -1 if no character available
  848. X;-
  849. X`09tstl`09chars_left`09`09; have we used all characters ?
  850. X`09bgtr`0950$`09`09`09; no --> 50$
  851. X`09bbsc`09#0, data_ready, 20$`09; check if input ready
  852. X5$:`09mnegl`09#1, r0`09`09`09; no characters read
  853. X`09ret`09`09`09`09; no
  854. X20$:
  855. X`09$qiow_g read_now_qio
  856. X`09blbc`09r0, 5$`09`09`09; error
  857. X;
  858. X;`09$qiow_s`09func=#io$_writevblk,chan=ttchan,-`09; debug write
  859. X;`09`09p1=ttbuf, p2=ttiosb+2, p4=#`5Ex1000
  860. X
  861. X`09movzwl`09ttiosb+2, chars_left`09`09; # chars read
  862. X`09movab`09ttbuf, char_pointer`09`09; store address of character
  863. X50$:
  864. X`09decl`09chars_left
  865. X`09movzbl`09@char_pointer, r0`09`09; get next char
  866. X`09incl`09char_pointer`09`09`09; point to next
  867. X`09ret
  868. X
  869. X
  870. X`09.entry`09-
  871. XTT_READ, `5Em<r2,r3>
  872. X;+
  873. X;`09INTEGER FUNCTION TT_READ( buffer, buf_len, data_len, term_len )
  874. X;`09buffer`09address of buffer or address of descriptor of buffer
  875. X;`09buf_len length of buffer.  If omitted then "buffer" is a descriptor
  876. X;`09data_len length of data read (# of characters)
  877. X;`09term_len length of terminator
  878. X;
  879. X;`09Value of function is the I/O status completion code
  880. X;-
  881. X`09movl`098(ap), r2`09`09; get buf_len
  882. X`09bneq`09100$`09`09`09; if <> 0 then it was specified
  883. X`09movq`09@4(ap), r2`09`09; get descriptor of buffer
  884. X`09`09`09`09`09; r2 = length, r3 = address
  885. X`09bicl2`09#`5EXFFFF0000, r2`09`09; want length only
  886. X`09brb`09200$
  887. X100$:
  888. X`09movl`09(r2), r2`09`09; get buffer length
  889. X`09movl`094(ap), r3`09`09; get buffer address
  890. X200$:
  891. X`09$qiow_s func=tt_func, chan=ttchan, iosb=ttiosb, -
  892. X`09`09p1=(r3), p2=r2, p3=tt_timed, p4=tt_term_addr
  893. X`09blbc`09r0, 600$`09`09; did $qio get an error.  yes --> 600$
  894. X
  895. X`09movzwl`09ttiosb+2, @12(ap)`09; store # characters read
  896. X`09cmpb`09(ap), #3`09`09; enough arguments supplied
  897. X`09bleq`09500$`09`09`09; no --> 500$
  898. X`09movl`0916(ap), r2`09`09; does user want terminator length
  899. X`09beql`09500$
  900. X`09movzwl`09ttiosb+6, (r2)`09`09; store terminator length
  901. X500$:
  902. X`09movzwl`09ttiosb, r0
  903. X600$:
  904. X`09ret
  905. X
  906. X`09.entry`09-
  907. XTT_READ_S, `5Em<>
  908. X;+
  909. X;`09CALL TT_READ_S( array, length, efn, iast, iosb )
  910. X;`09BYTE ARRAY( LENGTH )
  911. X;`09INTEGER iosb(2)
  912. X;
  913. X;`09reads a line asynchronously
  914. X;`09will set "iast" to one when complete
  915. X;-
  916. X`09$qio_s`09func=tt_func, -
  917. X`09`09chan=ttchan, -
  918. X`09`09efn=@12(ap), -
  919. X`09`09iosb=@20(ap), -
  920. X`09`09astadr=tt_read_s_ast, -
  921. X`09`09astprm=@16(ap), -
  922. X`09`09p1=@4(ap), p2=@8(ap)
  923. X`09blbc`09r0, 100$
  924. X`09ret
  925. X100$:
  926. X`09bsbw`09error
  927. X`09ret
  928. X
  929. X`09.align`09word
  930. X`09.entry`09-
  931. XTT_READ_S_AST, `5Em<>
  932. X`09movl`09#1, @4(ap)
  933. X`09ret
  934. X
  935. X
  936. X`09.entry`09-
  937. XTT_SET_READF, `5Em<r2,r3>
  938. X;+
  939. X;`09CALL TT_SET_READF( buffer, buf_len )
  940. X;`09buffer`09address of buffer or address of descriptor of buffer
  941. X;`09buf_len length of buffer.  If omitted then "buffer" is a descriptor
  942. X;-
  943. X`09movl`098(ap), r2`09`09; get buf_len
  944. X`09bneq`09100$`09`09`09; if <> 0 then it was specified
  945. X`09movq`09@4(ap), r2`09`09; get descriptor of buffer
  946. X`09`09`09`09`09; r2 = length, r3 = address
  947. X`09bicl2`09#`5EXFFFF0000, r2`09`09; want length only
  948. X`09brb`09200$
  949. X100$:
  950. X`09movl`09(r2), r2`09`09; get buffer length
  951. X`09movl`094(ap), r3`09`09; get buffer address
  952. X200$:
  953. X`09movl`09r3, read_fast_qio+qio$_p1`09; address of buffer
  954. X`09movl`09r2, read_fast_qio+qio$_p2`09; length of buffer
  955. X;`09movl`09tt_timed, read_fast_qio+qio$_p3 ; time out
  956. X`09movl`09tt_term_addr, read_fast_qio+qio$_p4 ; terminator pointer
  957. X;`09movl`09tt_func, read_fast_qio+qio$_func
  958. X`09movzwl`09ttchan, read_fast_qio+qio$_chan
  959. X
  960. X`09ret
  961. X
  962. X
  963. X`09.entry`09-
  964. XTT_READF, `5Em<r2,r3>
  965. X;+
  966. X;`09INTEGER FUNCTION TT_READF( data_len )
  967. X;`09data_len length of data read (# of characters) (not including term)
  968. X;
  969. X;`09This routine is used for reading a lot of data in binary mode
  970. X;`09with no echo.  READF stands for READ FAST.
  971. X;`09TT_READF_SET must be called first
  972. X;
  973. X;`09Value of function is the I/O status completion code
  974. X;-
  975. X
  976. X`09$qiow_g read_fast_qio
  977. X`09blbc`09r0, 600$`09`09; did $qio get an error.  yes --> 600$
  978. X
  979. X`09movzwl`09ttiosb+2, @4(ap)`09; store # characters read
  980. X`09movzwl`09ttiosb, r0
  981. X600$:
  982. X`09ret
  983. X
  984. X
  985. X`09.entry`09-
  986. XTT_PROMPT, `5Em<r2,r3,r4,r5>
  987. X;+
  988. X;`09INTEGER FUNCTION TT_PROMPT( prompt, prompt_len,
  989. X;`09`09buffer, buf_len, data_len, term_len )
  990. X;`09prompt  address of prompt string or address of descriptor
  991. X;`09prompt_len  length of prompt string.  If omitted then "prompt"
  992. X;`09`09`09`09`09`09is a descriptor
  993. X;`09buffer`09address of buffer or address of descriptor of buffer
  994. X;`09buf_len length of buffer.  If omitted then "buffer" is a descriptor
  995. X;`09data_len length of data read (# of characters)
  996. X;`09term_len length of terminator
  997. X;
  998. X;`09Value of function is the I/O status completion code
  999. X;-
  1000. X`09movl`0916(ap), r2`09`09; get buf_len
  1001. X`09bneq`09100$`09`09`09; if <> 0 then it was specified
  1002. X`09movq`09@12(ap), r2`09`09; get descriptor of buffer
  1003. X`09`09`09`09`09; r2 = length, r3 = address
  1004. X`09bicl2`09#`5EXFFFF0000, r2`09`09; want length only
  1005. X`09brb`09200$
  1006. X100$:
  1007. X`09movl`09(r2), r2`09`09; get buffer length
  1008. X`09movl`0912(ap), r3`09`09; get buffer address
  1009. X200$:
  1010. X`09movl`098(ap), r4`09`09; get prompt_len
  1011. X`09bneq`09300$`09`09`09; if <> 0 then it was specified
  1012. X`09movq`09@4(ap), r4`09`09; get descriptor of prompt string
  1013. X`09`09`09`09`09; r4 = length, r5 = address
  1014. X`09bicl2`09#`5EXFFFF0000, r4`09`09; get length only
  1015. X`09brb`09400$
  1016. X300$:
  1017. X`09movl`09(r4), r4`09`09; get prompt length
  1018. X`09movl`094(ap), r5`09`09; get prompt address
  1019. X400$:
  1020. X
  1021. X`09$qiow_s func=tt_p_func, chan=ttchan, iosb=ttiosb, -
  1022. X`09`09p1=(r3), p2=r2, p3=tt_timed, p5=r5, p6=r4
  1023. X`09blbc`09r0, 600$`09`09; did $qio get an error.  yes --> 600$
  1024. X
  1025. X`09movzwl`09ttiosb+2, @20(ap)`09; store # characters read
  1026. X`09cmpb`09(ap), #5`09`09; enough arguments supplied
  1027. X`09bleq`09500$`09`09`09; no --> 500$
  1028. X`09movl`0924(ap), r2`09`09; does user want terminator length
  1029. X`09beql`09500$
  1030. X`09movzwl`09ttiosb+6, (r2)`09`09; store terminator length
  1031. X500$:
  1032. X`09movzwl`09ttiosb, r0
  1033. X600$:
  1034. X`09ret
  1035. X
  1036. X
  1037. X`09.entry`09-
  1038. XTT_MBX_READ,`09`5Em<>
  1039. X;+
  1040. X; This is an AST routine which executes when the mailbox record has been rea
  1041. Vd.
  1042. X; The record itself is a status message which is assumed to say that
  1043. X; unsolicited data is available at the terminal
  1044. X;-
  1045. X`09blbc`09mbxiosb, 100$`09`09; on error, dont re-que read
  1046. X;`09we could have SS$_CANCEL or SS$_ABORT from the $CANCEL in the
  1047. X;`09exit handler
  1048. X`09movb`09#1, data_ready`09`09; indicate data is there
  1049. X`09bsbw`09queue_mbxread`09`09; queue another read request
  1050. X100$:
  1051. X`09ret
  1052. X
  1053. XQUEUE_MBXREAD:
  1054. X`09$qio_s`09efn=#2, func=#io$_readvblk, chan=mbxchan, iosb=mbxiosb,-
  1055. X`09`09astadr=tt_mbx_read,-
  1056. X`09`09p1=mbxbuf, p2=#mbxbuf_siz
  1057. X`09blbc`09r0, 100$
  1058. X`09rsb
  1059. X100$:
  1060. X`09bsbw`09error
  1061. X`09rsb
  1062. X
  1063. X;TT_WRITE$:
  1064. X;+
  1065. X;`09bsbw`09ttwrite
  1066. X;`09r3 contains length of buffer to write
  1067. X;`09the buffer is outbuf
  1068. X;-
  1069. X;`09movl`09r3, outbuf_qio+qio$_p2`09`09; store length of buffer
  1070. X;`09$qiow_g`09outbuf_qio
  1071. X;`09blbc`09r0, 100$
  1072. X;`09rsb
  1073. X;100$:
  1074. X;`09bsbw`09error
  1075. X;`09rsb
  1076. X
  1077. X`09.entry`09-
  1078. XTT_WRITE, `5Em<>
  1079. X;+
  1080. X;`09CALL TT_WRITE( array, length )
  1081. X;`09BYTE ARRAY( LENGTH )
  1082. X;`09writes buffer to terminal in noformat mode
  1083. X;-
  1084. X`09movl`094(ap), output_qio+qio$_p1`09; store address of buffer
  1085. X`09movl`09@8(ap), output_qio+qio$_p2`09; store length of buffer
  1086. X`09$qiow_g`09output_qio
  1087. X`09blbc`09r0, 100$
  1088. X`09ret
  1089. X100$:
  1090. X`09bsbw`09error
  1091. X`09ret
  1092. X
  1093. X`09.entry`09-
  1094. XTT_WRITE_S, `5Em<>
  1095. X;+
  1096. X;`09CALL TT_WRITE_S( array, length, efn )
  1097. X;`09BYTE ARRAY( LENGTH )
  1098. X;`09writes buffer to terminal in noformat mode
  1099. X;`09this puts the qio on the stack so that it can be called
  1100. X;`09synchronously with TT_WRITE
  1101. X;-
  1102. X`09$qio_s func=#io$_writevblk!io$m_noformat, -
  1103. X`09`09chan=ttchan, -
  1104. X`09`09efn=@12(ap), -
  1105. X`09`09p1=@4(ap), p2=@8(ap)
  1106. X`09blbc`09r0, 100$
  1107. X`09ret
  1108. X100$:
  1109. X`09bsbw`09error
  1110. X`09ret
  1111. X
  1112. X`09.entry -
  1113. XTT_CANCEL, `5Em<>
  1114. X`09clrl`09r0
  1115. X`09tstw`09ttchan`09`09; check channel is open
  1116. X`09beql`09100$
  1117. X`09$qiow_s`09func=#io$_readvblk!io$m_purge!io$m_timed,-
  1118. X`09`09chan=ttchan, p1=ttbuf, p2=#0
  1119. X;###`09`09`09; do read with 0 length buffer (p2)
  1120. X`09clrl`09chars_left`09; for TT_1_char_now
  1121. X`09clrl`09data_ready`09; say no data ready to read
  1122. X100$:
  1123. X`09ret`09`09`09; return with status in r0
  1124. X
  1125. X`09.entry -
  1126. XTT_CANCEL_IO, `5Em<>
  1127. X;+
  1128. X;`09cancels I/O on channel
  1129. X;-
  1130. X`09clrl`09r0
  1131. X`09tstw`09ttchan`09`09; check channel is open
  1132. X`09beql`09100$
  1133. X`09$cancel_s chan=ttchan
  1134. X`09bsbb`09error
  1135. X100$:`09ret`09`09`09; return with status in r0
  1136. X
  1137. XERROR:
  1138. X`09blbs`09r0, 100$
  1139. X`09pushl`09r0
  1140. X`09calls`09#1, G`5Elib$signal
  1141. X100$:
  1142. X`09rsb
  1143. X
  1144. X;`09.entry`09-
  1145. X;control_c, `5Em<>
  1146. X;`09movb`09#1, control_c_flag
  1147. X;`09ret
  1148. X
  1149. X
  1150. X`09.entry`09-
  1151. XSLEEP_SET, `5Em<>
  1152. X;+
  1153. X;`09CALL SLEEP_SET( efn , time )
  1154. X;`09INTEGER efn, time
  1155. X;`09use "efn" as event flag
  1156. X;`09sleep for "time" 100th's of a second
  1157. X;-
  1158. X`09movl`09@4(ap), sleep_efn
  1159. X`09emul`09#-100000, @8(ap), #0, sleep_time`09; get delta time format
  1160. X`09$setef_s efn=sleep_efn`09`09; set ef in case SLEEP_START not called
  1161. X`09ret
  1162. X
  1163. X`09.entry`09-
  1164. XSLEEP_START, `5Em<>
  1165. X;+
  1166. X;`09CALL SLEEP_START
  1167. X;`09starts a timer
  1168. X;-
  1169. X`09$setimr_g sleep_args
  1170. X`09blbc`09r0, 100$
  1171. X`09ret
  1172. X100$:`09bsbw`09error
  1173. X`09ret
  1174. X
  1175. X`09.entry`09-
  1176. XSLEEP_WAIT, `5Em<>
  1177. X;+
  1178. X;`09CALL SLEEP_WAIT
  1179. X;`09waits for sleep efn to turn on
  1180. X;-
  1181. X`09$waitfr_s efn=sleep_efn
  1182. X`09ret
  1183. X
  1184. Xtt_exit_handler = .
  1185. X`09.word`09`5Em<>
  1186. X`09$qiow_s func=#io$_setmode, chan=ttchan, iosb=ttiosb -
  1187. X`09`09p1=ttsavemode`09`09; reset terminal mode
  1188. X;`09if we get an error, too bad.
  1189. X`09ret
  1190. X
  1191. X`09.end
  1192. $ CALL UNPACK TTIO.MAR;49 980021740
  1193. $ create 'f'
  1194. X$!
  1195. X$!`09Create  UTIL.OLB
  1196. X$!
  1197. X$ MACRO ttio
  1198. X$ MACRO sleep
  1199. X$ MACRO imagedir
  1200. X$!
  1201. X$ LIBR/CRE util ttio,sleep,imagedir
  1202. X$ SET FILE/TRUNC util.olb
  1203. X$!
  1204. $ CALL UNPACK UTIL.COM;3 1963740437
  1205. $ v=f$verify(v)
  1206. $ EXIT
  1207.