|
DataMuseum.dkPresents historical artifacts from the history of: CR80 Hard and Floppy Disks |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CR80 Hard and Floppy Disks Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 6184 (0x1828)
Types: TextFile
Names: »DATA_LOGGER.S«
└─⟦b8af24a88⟧ Bits:30005796 CR80 Disc Pack ( MINICAMPS )
└─ ⟦this⟧ »GENS.D!DATA_LOGGER.D!DATA_LOGGER.S«
%LIST %LIST %LIST
"-----------------------------------------------------------------------
"
" MODULE NAME: DATA_LOGGER
" MODULE ID NBR: X
" MODULE VERSION: 0
" MODULE RELEASE: 0
" MODULE TYPE: UTILITY LINK (SUB)MODULE
" SPECIFICATIONS: X
" AUTHOR/DATE: LKN/810520
" DELIVERABLE: NO
" SOURCE LANGUAGE: SWELL
" COMPILE COMPUTER: CR80
" TARGET COMPUTER: CR80
" OPERATING SYSTEM: AMOS
"
"-----------------------------------------------------------------------
"
" CHANGE RECORD
"
" VERSION RELEASE AUTHOR/DATE DESCRIPTION OF CHANGE
" ------- ------- ----------- ---------------------
"
"-----------------------------------------------------------------------
%NOLIST %NOLIST %NOLIST
submodule data_logger;
%NOLIST
%SOURCE @**DAMOS.D*GENS.D*GENERAL.S
%SOURCE @**DAMOS.D*GENS.D*HARDWARE.S
%SOURCE @**DAMOS.D*GENS.D*DAMOS_GENERAL.S
%SOURCE @**DAMOS.D*KERNEL.D*GENS.D*KERNEL_GENERAL.S
%SOURCE @**DAMOS.D*KERNEL.D*GENS.D*PPP.S
%SOURCE @**DAMOS.D*KERNEL.D*GENS.D*TEST_PPP.I
procedure hide_away
"================="
(r6); " C K
%SOURCE @**GENS.D*SWELLPREFIX.D*GENERALPARAMS.S
%SOURCE @**GENS.D*SWELLPREFIX.D*MONITORNAMES.S
%SOURCE @**GENS.D*SWELLPREFIX.D*IOSPARAMS.S
%SOURCE @**GENS.D*UTILITYHELP.D*UTH.I
%SOURCE @**GENS.D*DEBUG.D*DEBUG.I
%LIST
const
dr = 128;
dx = 129;
dd = 130;
dt = 131;
t_outtextb = 'OUTTEXTB(:0:)';
t_outhexa = 'OUTHEXA(:0:)';
t_flush = 'FLUSH(:0:)';
var
logfile, out: integer; "ptr to output file type
saveregs: array [0..7] of integer;
procedure x_outb
"=============="
(r3; " C K char to print
r6); " C D link
begin
r6 => saveregs[6];
r4 => saveregs[4];
logfile => r4;
outb(r4, r3, r6);
if out => r4 <> nil then outb(r4, r3, r6);
saveregs[4] => r4;
exit(saveregs[6]);
end;
procedure x_outhexa
"================="
(r2; " C K value to print
r3; " C K preceeding character
r6); " C K link
begin
r7 => saveregs[7];
stc(6, address(saveregs[7])=>r7);
logfile => r4;
r4@filetype.s => r4;
switch mon(stream, outhexa, r4, r2, r3, r7): fail_pass to
fail: fileerror(logfile=>r4, address(t_outhexa)=>r5, r7, r6);
end;
if out => r4 <> nil then
begin
r4@filetype.s => r4;
switch mon(stream, outhexa, r4, r2, r3, r7): fail_pass to
fail: fileerror(out=>r4, address(t_outhexa)=>r5, r7, r6);
end;
end;
uns(7, address(saveregs)=>r7);
exit(r6);
end;
procedure x_outtextb
"=================="
(r0; " C K ptr to text
r6); " C K link
begin
r7 => saveregs[7];
stc(6, address(saveregs[7])=>r7);
logfile => r4;
r4@filetype.s => r4;
switch mon(stream, outtextb, r4, r0=>r6, r7): fail_pass to
fail: fileerror(logfile=>r4, address(t_outtextb)=>r5, r7, r6);
end;
if out => r4 <> nil then
begin
r4@filetype.s => r4;
switch mon(stream, outtextb, r4, r0=>r6, r7): fail_pass to
fail: fileerror(out=>r4, address(t_outtextb)=>r5, r7, r6);
end;
end;
uns(7, address(saveregs)=>r7);
exit(r6);
end;
procedure x_flush
"==============="
(r6); " C K link
begin
r6 => saveregs[6];
r4 => saveregs[4];
if out => r4 <> nil then
begin
r4@filetype.s => r4;
switch mon(stream, flush, r4, r7): fail_pass to
fail: fileerror(out=>r4, address(t_flush)=>r5, r7, r6);
end;
end;
saveregs[4] => r4;
exit(saveregs[6]);
end;
procedure print_it
"================"
(r0; " C - address of text
r1; " C - address of first word
r2; " C - labelling address
r3; " C - word count
r4; " - D
r5; " - D
r7; " - D
r6); " C - link
var
link, startposition, count: integer;
begin
r6 => link;
r3 => count;
x_outb(10=>r3, r6);
x_outtextb(r0, r6);
x_outb(10=>r3, r6);
10=>r5;
while r5-1 <> -1 do x_outb(' '=>r3, r6);
x_outhexa(r2, ' '=>r3, r6);
x_outb(':'=>r3, r6);
0 => r0;
while r0 < count => r3 do
begin
if r0 <> 0 logand r0=>r2 extract 3 = 0 then
begin
x_outb(10=>r3, r6);
10=>r5;
while r5-1 <> -1 do x_outb(' '=>r3, r6);
x_outhexa(r1=>r2, ' '=>r3, r6);
x_outb(':'=>r3, r6);
end;
x_outhexa(r1@integer=>r2, ' '=>r3, r6);
incd(r0, r1);
end;
x_outb(10=>r3, r6);
x_flush(r6);
exit(link);
end; "print_it"
procedure dump_r
"=============="
(textaddr: integer;
r7); " C K link
begin
r7@dump_r.textaddr => r0;
ppp_addr@ppp.ppb.context_admin.cur_ptr => r1;
8 => r3;
print_it(r0, r1, 0=>r2, r3, "*" r4, r5, r7, r6);
trp(0);
rtm(0, size(dump_r));
end; "dump_r"
procedure dump_x
"=============="
(textaddr: integer;
regno: integer;
count: integer;
r7); " C K link
begin
r7@dump_x.textaddr=>r0;
ppp_addr@ppp.ppb.context_admin.cur_ptr => r1;
r7@dump_x.regno => r3;
(r1+r3)@integer => r1;
r1 => r2;
r7@dump_x.count => r3;
print_it(r0, r1, r2, r3, "*" r4, r5, r7, r6);
trp(0);
rtm(0, size(dump_x));
end; "dump_x"
procedure dump_d
"=============="
(textaddr: integer;
dataaddr: integer;
count: integer;
r7); " C K link
begin
r7@dump_d.textaddr => r0;
r7@dump_d.dataaddr => r1;
r1 => r2;
r7@dump_d.count => r3;
print_it(r0, r1, r2, r3, "*" r4, r5, r7, r6);
trp(0);
rtm(0, size(dump_d));
end; "dump_d"
procedure dump_t
"=============="
(textaddr: integer;
r7); " C K link
begin
x_outb(10=>r3, r6);
r7@dump_t.textaddr => r0;
x_outtextb(r0, r6);
x_outb(10=>r3, r6);
trp(0);
rtm(0, size(dump_t));
end; "dump_t"
export procedure init_data_logger
"==============================="
(r4; " C K ptr to output filetype
r6); " C K link
var
saveregs: array [0..7] of integer;
begin
r7 => saveregs[7];
stc(6, address(saveregs[7])=>r7);
r4 => logfile;
address(coutfiletype) => r6;
if r6 = r4 then nil => r6;
r6 => out;
init_mon(location(dump_r)=>r0, 1=>r1, dr=>r4, r6);
init_mon(location(dump_x)=>r0, 1=>r1, dx=>r4, r6);
init_mon(location(dump_d)=>r0, 1=>r1, dd=>r4, r6);
init_mon(location(dump_t)=>r0, 1=>r1, dt=>r4, r6);
uns(7, address(saveregs)=>r7);
exit(r6);
end; "init_data_logger"
begin
end; "hideaway"
endmodule «a5»