Re:
> 0005c86c sendfuncmsg+$a0 0a775880 COMCLR,>= r23,r19,r0
> 0005c870 sendfuncmsg+$a4 6bd33d21 STW r19,-368(sr0,r30)
> 0005c874 sendfuncmsg+$a8 e85f1de5 BL ?sendfuncmsg+$3c,r2
the above is the call to GETPRIVMODE.
> 0005c878 sendfuncmsg+$ac 08000240 OR r0,r0,r0
> 0005c87c sendfuncmsg+$b0 341a3822 LDO 7185(r0),r26
> 0005c880 sendfuncmsg+$b4 34193fff LDO -1(r0),r25
> 0005c884 sendfuncmsg+$b8 d7bf1811 ZDEPI -1,31,15,r29
> 0005c888 sendfuncmsg+$bc 37d83d21 LDO -368(r30),r24
> 0005c88c sendfuncmsg+$c0 0bb874c0 SUBT,> r24,r29,r0 <-- traps
> 0005c890 sendfuncmsg+$c4 d67f19ef ZDEPI -1,16,17,r19
> 0005c894 sendfuncmsg+$c8 0a7844c0 SUBT,< r24,r19,r0
> 0005c898 sendfuncmsg+$cc 4bdc3c91 LDW -440(sr0,r30),r28
the above is part of the code building the parameters to GENMSG.
The code at sendfuncmsg+$c0 (and above it) is saying:
Put a constant -1 into register R25.
Put a constant 32767 into register r29 (the ZDEPI)
Get the address of bbuf [1] into register R24. (the LDO -368)
Make sure the address is in the range -32768..32767 (the two SUBTs)
Aha! The address of bbuf [1] is, of course, not in that range ... trap!
Why is Pascal checking that an address is within a shortint range?
Because you said:
PROCEDURE GENMSG (setno, error, mask, parm1, parm2, parm3, parm4,
parm5: shortint;
destdev, q1, q2, q3, flags: shortint );
external spl variable;
Thus, when you do:
GENMSG ( -1, baddress(bbuf[1]),0,,,,,,ldev,,,,imp);
the second parameter (formal name "error") is a *SHORTINT* by value.
According to AVATAR's "LOOK" function, the NM genmsg is defined more like:
Function genmsg (
setno : shortint; {parm 1}
error : integer; {parm 2}
mask : shortint; {parm 3}
parm1 : integer; {parm 4}
parm2 : integer; {parm 5}
parm3 : integer; {parm 6}
parm4 : integer; {parm 7}
parm5 : integer; {parm 8}
destdev : shortint; {parm 9}
q1 : shortint; {parm 10}
q2 : integer; {parm 11}
q3 : shortint; {parm 12}
flags : shortint) {parm 13}
: shortint;
external;
What does genmsg return? I have no idea!
BUT...there may be further problems with your call to genmsg.
AND...if you pass a sufficiently bad LDEV to genmsg, you can get
a system abort!
Also, I'm not sure <esc>&000L is what you want. On an HP terminal
that seems to turn off the function key display, not position the
text in the 25th line.
The following Pascal source code compiles and runs, sending messages
to terminals (after validating the LDEV):
{sendmsg.source cap=pm}
$standard_level 'os_features'$
program m (output, parm);
type
io_device_classes = (io_not_configured, io_disc, io_tape,
io_terminal, io_printer,
io_serial_printer, io_spooler,
io_data_comm, io_ds_term,
io_ds_printer, io_user_device);
pac80 = packed array [1..80] of char;
pac132 = packed array [1..132] of char;
str80 = string [80];
str132 = string [132];
var
parm : shortint;
Procedure getprivmode; intrinsic;
Procedure print; intrinsic;
Procedure setjcw; intrinsic;
Procedure terminate; intrinsic;
Function genmsg (
setnum : shortint; {parm 1}
msg : integer; {parm 2}
mask : shortint; {parm 3}
parm1 : integer; {parm 4}
parm2 : integer; {parm 5}
parm3 : integer; {parm 6}
parm4 : integer; {parm 7}
parm5 : integer; {parm 8}
dest : shortint; {parm 9}
reply : shortint; {parm 10}
offset : integer; {parm 11}
dataseg : shortint; {parm 12}
flags : shortint) {parm 13}
: shortint
option default_parms (
parm1 := 0,
parm2 := 0,
parm3 := 0,
parm4 := 0,
parm5 := 0,
dest := 0,
reply := 0,
offset := 0,
dataseg := 0,
flags := 0);
external;
Function io_device_class (ldev : integer)
: io_device_classes;
external;
Function io_device_subclass (ldev : integer)
: integer;
external;
{**************************************************************}
Function priv_io_device_class (ldev : integer)
: io_device_classes
$exec_privilege 2$;
begin
priv_io_device_class := io_device_class (ldev)
end {priv_io_device_class proc};
{**************************************************************}
function sendfuncmsg (
ldev : shortint;
msg : pac80;
len : shortint)
: integer {returns status}
$exec_privilege 2$;
label
999;
const
max_message_bytes = 80;
var
bbuf : pac132;
dc : io_device_classes;
i : integer;
preempt : shortint;
rslt : shortint;
s : string [max_message_bytes + 10];
status : integer;
{--------------------------}
Procedure fail (n : integer; why : str80);
begin
if strlen (why) > 0 then
print (why, -strlen (why), 0);
status := n;
goto 999;
end {fail Proc};
{--------------------------}
begin
status := 0; {assume success}
preempt := 1;
dc := priv_io_device_class (ldev);
if dc = io_not_configured then
fail (-1, 'LDEV not configured');
if not (dc in [io_terminal, io_ds_term]) then
fail (-2, 'LDEV not a terminal');
{validate the message length...}
if len < 0 then
fail (-3, 'Message length is negative');
if len > max_message_bytes then
fail (-4, 'Message is too long');
{Build message buffer: addressing + text + null ...}
s := #27'j000L'; {move to line 0?}
i := strlen (s); {length of addressing stuff}
setstrlen (s, i + len + 1);
strmove (len, msg, 1, {source}
s, i + 1); {dest}
s [i + len + 1] := chr (0);
try
begin
rslt := genmsg ( -1,
baddress (bbuf [1]),
0,
, {parm1}
, {parm2}
, {parm3}
, {parm4}
, {parm5}
ldev, {dest }
-1, {reply }
-1, {offset}
, {dst }
1); {ctrl 1 = soft preempt, 2 = hard preempt}
end
recover
fail (escapecode, 'unexpected trap in sendfuncmsg or genmsg');
{Note: genmsg seems to always return -1 and condition code ccE}
999:
sendfuncmsg := status; {let caller know the result}
end {sendfuncmsg proc};
{**************************************************************}
procedure test (ldev : shortint);
var
msg : pac80;
status : integer;
begin
msg := 'hi there';
status := sendfuncmsg (ldev, msg, 8);
writeln ('status = ', status:1);
end {test proc};
{**************************************************************}
begin
if parm = 0 then
begin
writeln ('You must specify an LDEV via PARM=');
setjcw (-1);
terminate;
end;
test (parm);
end.
* To join/leave the list, search archives, change list settings, *
* etc., please visit http://raven.utc.edu/archives/hp3000-l.html *
|
