tldm-universe/Ardent/UV/APP.PROGS/AMLC

329 lines
9.3 KiB
Plaintext
Raw Permalink Normal View History

2024-09-09 21:51:08 +00:00
********************************************************************************
*
* Support of PR1ME INFORMATION Subroutine '!AMLC'
*
* Module %M% Version %I% Date %H%
*
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
* This is unpublished proprietary source code of Ardent Software Inc.
* The copyright notice above does not evidence any actual or intended
* publication of such source code.
*
*******************************************************************************
*
* Maintenence log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description.........................................
* 06/16/99 17755 RJE Fix functionality of key = 4 and key = 5
* 10/14/98 23801 SAP Change copyrights.
* 10/08/91 8338 LPC Fixed assignment to variable "filestat".
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
*
*******************************************************************************
$OPTIONS DEFAULT
subroutine PR1ME(key , line , buffer , count , carrier)
*************************************************************************
* *
* Support of PR1ME INFORMATION subroutine !AMLC *
* *
* This subroutine maintans a named common segment called 'AMLC%' *
* to keep a file descriptor for each terminal opened using *
* !AMLC (This name cannot possibly conflict with existing *
* INFORMATION programs cause the character '%' is illegal *
* on INFORMATION). *
* *
* This subroutine produced error messages on the controling *
* terminal. If users wish to suppress the messages, change *
* the definition of ERROR.MESSAGE, re-compile and re-catalog *
* this subroutine. *
* *
* Users wishing more efficient code might want to convert *
* existing programs using !AMLC to use the more effieicnt *
* uni*Verse statments: OPENDEV, READSEQ, WRITESEQ, READBLK, *
* WRITEBLK, STATUS, NOBUF, and FLUSH. *
* *
*************************************************************************
equ ERROR.MESSAGE lit '$TRUE'
common /AMLC%/ init,AMLC(128),open(128)
if not(init) then mat open = 0; init = 1
if line < 0 or line > 128 then
if ERROR.MESSAGE then
crt '!AMLC: Illegal terminal line number'
end
return
end
if not(open(line)) then
dev = fmt(line,if line>99 then "r(TTY%3)" else "r(TTY%2)")
opendev dev to AMLC(line) then
nobuf AMLC(line) then null
open(line) = 1
end else
if ERROR.MESSAGE then
crt "!AMLC: can't open ":dev
end
return
end
end
begin case
case key = 1
*************************************************************************
* *
* KEY = 1 *
* *
* 1) Input <count> characters *
* *
* Since readblk will terminate input when a buffer is sent *
* from the tty to the system (on each character when terminal *
* is in CBREAK or RAW mode, at the end of each line otherwise) *
* we have to loop and read until the number of characters *
* desired have been read. *
* *
*************************************************************************
buffer = ''
loop
while count > 0 do
readblk buf0 from AMLC(line),count then
count -= len(buf0)
end else
if ERROR.MESSAGE then
crt '!AMLC: unable to read from TTY':line
end
return
end
buffer := buf0
repeat
for i=1 to count; buffer[1,i] = char(bitand(seq(buffer[1,i]),127)); next
return
case key = 2
*************************************************************************
* *
* KEY = 2 *
* *
* 1) Input <count> characters, or until a LINE FEED *
* (ASCII 10) or CARRIAGE RETURN (ASCII 13) is *
* encountered, whichever occurs first. *
* *
* NOTE: if the terminal is NOT in CBREAK or RAW mode, *
* a buffer is automatically termiated by NL (or the EOF/BRK) *
* character, thus this key can be replaced by the code: *
* READBLK buffer FROM AMLC(line),count *
* *
*************************************************************************
buffer = ''
for i=1 to count
readblk buf0 from AMLC(line),1 then
s = bitand(seq(buf0),127); buf0 = char(s)
if s=10 or s=13 then
return
end else
buffer := buf0
end
end else
if ERROR.MESSAGE then
crt '!AMLC: Unable to read from TTY':line
end
return
end
next i
return
case key = 3
*************************************************************************
* *
* KEY = 3 *
* *
* 1) Output <count> characters *
* *
* PR1ME maximum of 80 does not apply to uni*Verse *
* *
*************************************************************************
writeblk buffer[1,count] on AMLC(line) else
if ERROR.MESSAGE then
crt '!AMLC: Unable to write to TTY':line
end
end
return
case key = 4
*************************************************************************
* *
* KEY = 4 *
* *
* 1) Return the number of characters waiting for input *
* in <count> *
* 2) Determine the carrier status and return result *
* in <carrier> *
* *
* Uni*Verse is currently unable to determine the carrier *
* status of a TTY, thus result is also always 1 *
* *
*************************************************************************
status filestat from AMLC(line) else
if ERROR.MESSAGE then
crt '!AMLC: Unable to determine status of TTY':line
end
return
end
count = filestat<4>
carrier = 1
return
case key = 5
*************************************************************************
* *
* KEY = 5 *
* *
* 1) Determine if there is enough room in buffer for *
* <count> characters and return the result in <count> *
* 2) Determine the carrier status and return result *
* in <carrier> *
* *
* Uni*Verse is currently unable to determine the carrier *
* status of a TTY, thus result is also always 1 *
* *
*************************************************************************
status filestat from AMLC(line) else
if ERROR.MESSAGE then
crt '!AMLC: Unable to determine status of TTY':line
end
return
end
count = (count <= filestat<19>)
carrier = 1
return
case key=6
*************************************************************************
* *
* KEY = 6 *
* *
* 1) Input all available characters in the input buffer *
* maximum = <count>, return in <count> actual number *
* of characters input *
* *
*************************************************************************
status filestat from AMLC(line) else
if ERROR.MESSAGE then
crt '!AMLC: Unable to determine status of TTY':line
end
return
end
if count > filestat<19> then count = filestat<19>
readblk buffer from AMLC(line),count else
if ERROR.MESSAGE then
crt '!AMLC: Unable to read from TTY':line
end
end
return
case key=7
*************************************************************************
* *
* KEY = 7 *
* *
* 1) Return in <count> the amount of output buffer space *
* available. *
* *
*************************************************************************
status filestat from AMLC(line) else
if ERROR.MESSAGE then
crt '!AMLC: Unable to determine status of TTY':line
end
return
end
count = filestat<4>
return
case key=8
*************************************************************************
* *
* KEY = 8 *
* *
* 1) Flush the input buffer *
* *
* Since uni*Verse does not support seperate flushing of input *
* and output buffers, fall into KEY# 10 *
* *
*************************************************************************
case key=9
*************************************************************************
* *
* KEY = 9 *
* *
* 1) Flush the output buffer *
* *
* Since uni*Verse does not support seperate flushing of input *
* and output buffers, fall into KEY# 10 *
* *
*************************************************************************
case key=10
*************************************************************************
* *
* KEY = 10 *
* *
* 1) Flush both the input & output buffers *
* *
*************************************************************************
ttyctl AMLC(line),9 else
if ERROR.MESSAGE then
crt '!AMLC: Unable to flush buffer on TTY':line
end
end
return
case key=11
*************************************************************************
* *
* KEY = 11 *
* *
* 1) Output characters to available room in output buffer *
* return in <count> the number of character NOT output *
* *
*************************************************************************
status filestat from AMLC(line) else
if ERROR.MESSAGE then
crt '!AMLC: Unable to determine status of TTY':line
end
return
end
cnt = filestat<4>
if cnt > count then cnt = count
writeblk buffer[1,cnt] on AMLC(line) else
if ERROR.MESSAGE then
crt '!AMLC: Unable to write to TTY':line
end
return
end
count -= cnt
return
case 1
if ERROR.MESSAGE then
crt '!AMLC: Illegal argument'
end
return
end case