792 lines
25 KiB
Plaintext
792 lines
25 KiB
Plaintext
sample: DO;
|
|
|
|
$include(doslibs.inc)
|
|
|
|
DECLARE CR LITERALLY '13';
|
|
DECLARE LF LITERALLY '10';
|
|
|
|
DECLARE FALSE LITERALLY '0';
|
|
DECLARE TRUE LITERALLY '0FFh';
|
|
|
|
DECLARE CRLF (*) BYTE DATA (CR,LF,24h);
|
|
|
|
DECLARE error_status BYTE;
|
|
DECLARE err WORD;
|
|
|
|
DECLARE version WORD;
|
|
DECLARE version_major BYTE AT(.version);
|
|
DECLARE version_minor BYTE AT(.version + 1);
|
|
|
|
DECLARE psps SELECTOR;
|
|
DECLARE psp BASED psps STRUCTURE (
|
|
skip1 (2) BYTE,
|
|
top_of_memory WORD,
|
|
skip2 (28h) BYTE,
|
|
envs SELECTOR,
|
|
skip3 (52h) BYTE,
|
|
unformated_parameter_length BYTE,
|
|
unformated_parameter_area (127) BYTE);
|
|
|
|
DECLARE any_name (*) BYTE INITIAL('*.*',0);
|
|
|
|
|
|
error_if: PROCEDURE(condition);
|
|
DECLARE condition BYTE;
|
|
IF condition THEN
|
|
DO;
|
|
CALL dos_std_string_out(@('** Error',CR,LF,24h));
|
|
error_status = 2;
|
|
CALL dos_std_out(7);
|
|
END;
|
|
END error_if;
|
|
|
|
error_if_not_zero: PROCEDURE(code);
|
|
DECLARE code WORD;
|
|
IF code <> 0 THEN
|
|
DO;
|
|
CALL dos_std_string_out(@('** Error: ',24h));
|
|
CALL print_word(code, 1, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
error_status = 2;
|
|
CALL dos_std_out(7);
|
|
END;
|
|
END error_if_not_zero;
|
|
|
|
print_string: PROCEDURE(bufferp);
|
|
DECLARE bufferp POINTER;
|
|
DECLARE buffer BASED bufferp (1) BYTE;
|
|
DECLARE k WORD;
|
|
k = 0;
|
|
DO WHILE buffer(k) <> 0;
|
|
CALL dos_std_out(buffer(k));
|
|
k = k + 1;
|
|
END;
|
|
END print_string;
|
|
|
|
print_word: PROCEDURE(n, digits, base, leading_zeros) REENTRANT;
|
|
DECLARE n WORD, digits INTEGER, base WORD, leading_zeros BYTE;
|
|
DECLARE ch BYTE;
|
|
IF (n < base) THEN
|
|
DO;
|
|
IF leading_zeros THEN
|
|
ch = '0';
|
|
ELSE
|
|
ch = ' ';
|
|
DO WHILE digits > 1;
|
|
CALL dos_std_out(ch);
|
|
digits = digits - 1;
|
|
END;
|
|
IF n > 10 THEN
|
|
ch = 'A' + (n - 10);
|
|
ELSE
|
|
ch = '0' + n;
|
|
CALL dos_std_out(ch);
|
|
END;
|
|
ELSE
|
|
DO;
|
|
CALL print_word(n / base, digits - 1, base, leading_zeros);
|
|
CALL print_word(n MOD base, 1, base, leading_zeros);
|
|
END;
|
|
END print_word;
|
|
|
|
print_dword: PROCEDURE(n, digits, base, leading_zeros) REENTRANT;
|
|
DECLARE n DWORD, digits INTEGER, base WORD, leading_zeros BYTE;
|
|
DECLARE ch BYTE;
|
|
IF (n < base) THEN
|
|
DO;
|
|
IF leading_zeros THEN
|
|
ch = '0';
|
|
ELSE
|
|
ch = ' ';
|
|
DO WHILE digits > 1;
|
|
CALL dos_std_out(ch);
|
|
digits = digits - 1;
|
|
END;
|
|
IF n > 10 THEN
|
|
ch = 'A' + (n - 10);
|
|
ELSE
|
|
ch = '0' + n;
|
|
CALL dos_std_out(ch);
|
|
END;
|
|
ELSE
|
|
DO;
|
|
CALL print_word(n / base, digits - 1, base, leading_zeros);
|
|
CALL print_word(n MOD base, 1, base, leading_zeros);
|
|
END;
|
|
END print_dword;
|
|
|
|
print_time: PROCEDURE(timep, print_hundreths);
|
|
DECLARE timep POINTER, print_hundreths BYTE;
|
|
DECLARE time BASED timep STRUCTURE(
|
|
hundredeths BYTE,
|
|
seconds BYTE,
|
|
minutes BYTE,
|
|
hours BYTE);
|
|
CALL print_word(time.hours, 2, 10, FALSE);
|
|
CALL dos_std_out(':');
|
|
CALL print_word(time.minutes, 2, 10, TRUE);
|
|
CALL dos_std_out(':');
|
|
CALL print_word(time.seconds, 2, 10, TRUE);
|
|
IF print_hundreths THEN
|
|
DO;
|
|
CALL dos_std_out(':');
|
|
CALL print_word(time.hundredeths, 2, 10, TRUE);
|
|
END;
|
|
END print_time;
|
|
|
|
print_date: PROCEDURE(datep);
|
|
DECLARE datep POINTER;
|
|
DECLARE date BASED datep STRUCTURE(
|
|
day BYTE,
|
|
month BYTE,
|
|
year WORD);
|
|
CALL print_word(date.month, 2, 10, FALSE);
|
|
CALL dos_std_out('-');
|
|
CALL print_word(date.day, 2, 10, FALSE);
|
|
CALL dos_std_out('-');
|
|
CALL print_word(date.year, 1, 10, FALSE);
|
|
END print_date;
|
|
|
|
|
|
DECLARE INT LITERALLY '0FFh';
|
|
DECLARE int_count BYTE;
|
|
|
|
int_proc: PROCEDURE INTERRUPT int;
|
|
int_count = 1;
|
|
END int_proc;
|
|
|
|
|
|
/* Main program */
|
|
|
|
CALL dos_std_string_out(@('DOS Library Tests, X003',CR,LF,24h));
|
|
error_status = 0;
|
|
|
|
|
|
/* Version Number Test */
|
|
|
|
DO;
|
|
CALL dos_std_string_out(@('<> Test for DOS Version',CR,LF,24h));
|
|
version = dos_version;
|
|
CALL dos_std_string_out(@('DOS Version = ',24h));
|
|
CALL print_word(version_major, 1, 10, FALSE);
|
|
CALL dos_std_out('.');
|
|
CALL print_word(version_minor, 1, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
END;
|
|
|
|
|
|
/* Program Segment Prefix Access Test */
|
|
|
|
DO;
|
|
DECLARE k WORD;
|
|
DECLARE envw WORD;
|
|
DECLARE envs SELECTOR AT (@envw);
|
|
DECLARE env BASED envs (8000h) BYTE;
|
|
|
|
CALL dos_std_string_out(@('<> Test Program Segment Prefix Access',CR,LF,24h));
|
|
psps = dos_get_psp;
|
|
|
|
CALL dos_std_string_out(@('Command line: ',24h));
|
|
k = 0;
|
|
DO WHILE k < psp.unformated_parameter_length
|
|
AND psp.unformated_parameter_area(k) > CR;
|
|
CALL dos_std_out(psp.unformated_parameter_area(k));
|
|
k = k + 1;
|
|
END;
|
|
CALL dos_std_string_out(@CRLF);
|
|
|
|
CALL dos_std_string_out(@('Environment selector: ',24h));
|
|
envs = psp.envs;
|
|
CALL print_word(envw, 4, 16, TRUE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
|
|
CALL dos_std_string_out(@('Environment strings: ',CR,LF,24h));
|
|
k = 0;
|
|
DO WHILE env(k) <> 0;
|
|
CALL dos_std_string_out(@(' ',24h));
|
|
DO WHILE env(k) <> 0;
|
|
CALL dos_std_out(env(k));
|
|
k = k + 1;
|
|
END;
|
|
CALL dos_std_string_out(@CRLF);
|
|
k = k + 1;
|
|
END;
|
|
|
|
IF version_major >= 3 THEN
|
|
DO;
|
|
CALL dos_std_string_out(@('Invocation path: ',24h));
|
|
k = k + 3; /* skip over byte 0 and word count */
|
|
DO WHILE env(k) <> 0;
|
|
CALL dos_std_out(env(k));
|
|
k = k + 1;
|
|
END;
|
|
CALL dos_std_string_out(@CRLF);
|
|
END;
|
|
END;
|
|
|
|
|
|
/* Keyboard Input Test */
|
|
|
|
DO;
|
|
DECLARE buf(16) BYTE, ch BYTE, k WORD;
|
|
CALL dos_std_string_out(@('<> Test Keyboard Input',CR,LF,24h));
|
|
CALL dos_std_string_out(@('Please type (type ENTER at end): abc',CR,LF,24h));
|
|
k = 0;
|
|
DO WHILE k < SIZE(buf) AND (ch := dos_std_in) <> CR;
|
|
buf(k) = ch;
|
|
k = k + 1;
|
|
END;
|
|
buf(k) = 24h;
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL dos_std_string_out(@('Input was: ',24h));
|
|
CALL dos_std_string_out(@buf);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL error_if(k <> 3 OR cmpb(@buf, @('abc'), k) <> 0FFFFh);
|
|
END;
|
|
|
|
|
|
/* Direct Console I/O Test */
|
|
|
|
DO;
|
|
DECLARE (ch1, ch2) BYTE;
|
|
CALL dos_std_string_out(@('<> Test Direct Console I/O',CR,LF,24h));
|
|
CALL dos_std_string_out(
|
|
@('Each character you type will be repeatedly displayed',CR,LF,24h));
|
|
CALL dos_std_string_out(@('until you press ENTER',CR,LF,24h));
|
|
ch1 = dos_direct_in_noecho;
|
|
DO WHILE ch1 <> CR;
|
|
DO WHILE (ch2 := dos_direct_in) = 0FFh;
|
|
CALL dos_direct_out(ch1);
|
|
END;
|
|
ch1 = ch2;
|
|
END;
|
|
CALL dos_std_string_out(@CRLF);
|
|
END;
|
|
|
|
|
|
/* Console Input Without Echo Test */
|
|
|
|
DO;
|
|
DECLARE ch BYTE;
|
|
CALL dos_std_string_out(@('<> Console Input Without Echo Test',CR,LF,24h));
|
|
CALL dos_std_string_out(
|
|
@('Each character you type will not be echoed directly. Press ENTER to continue.',CR,LF,24h));
|
|
DO WHILE (ch := dos_std_in_noecho) <> CR;
|
|
CALL dos_std_string_out(@('The character you input was: ',24h));
|
|
CALL dos_std_out(ch);
|
|
CALL dos_std_string_out(@CRLF);
|
|
END;
|
|
CALL dos_std_string_out(@CRLF);
|
|
END;
|
|
|
|
|
|
/* Buffered Keyboard Input */
|
|
|
|
DO;
|
|
DECLARE buf8 (8) BYTE;
|
|
buf8(0) = 6;
|
|
CALL dos_std_string_out(@('<> Buffered Keyboard Input Test',CR,LF,24h));
|
|
CALL dos_std_string_out(@('Input 6 characters: ',24h));
|
|
CALL dos_buffered_std_in(@buf8);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL error_if(buf8(1) > buf8(0));
|
|
CALL error_if(buf8(2+buf8(1)) <> CR);
|
|
buf8(2+buf8(1)) = 24h;
|
|
CALL dos_std_string_out(@('Input was: ',24h));
|
|
CALL dos_std_string_out(@buf8(2));
|
|
CALL dos_std_string_out(@CRLF);
|
|
END;
|
|
|
|
|
|
/* Check Input Status & Clear Keyboard Buffer and Invoke Keyboard Function */
|
|
|
|
DO;
|
|
DECLARE done BYTE;
|
|
CALL dos_std_string_out(
|
|
@('<> Check Input Status & Clear Keyboard Buffer Test',CR,LF,24h));
|
|
CALL dos_std_string_out(
|
|
@('Press any key to continue (don''t press ENTER)',CR,LF,24h));
|
|
done = FALSE;
|
|
DO WHILE NOT done;
|
|
done = dos_check_std_in; /* 0FFh => key pressed, 0 => no input */
|
|
END;
|
|
CALL dos_std_string_out(@('Press the ENTER key',CR,LF,24h));
|
|
CALL error_if(dos_clear_and_std_in(01h) <> CR); /* Standard Input */
|
|
END;
|
|
|
|
|
|
/* Get/Set Date Test */
|
|
|
|
DO;
|
|
DECLARE date1 STRUCTURE(
|
|
day BYTE,
|
|
month BYTE,
|
|
year WORD);
|
|
DECLARE date2 STRUCTURE(
|
|
day BYTE,
|
|
month BYTE,
|
|
year WORD);
|
|
DECLARE day BYTE;
|
|
|
|
CALL dos_std_string_out(@('<> Test Get/Set Date',CR,LF,24h));
|
|
day = dos_get_date(@date1);
|
|
CALL dos_std_string_out(@('Date is: ',24h));
|
|
CALL print_date(@date1);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL dos_std_string_out(@('Day of week is: ',24h));
|
|
CALL print_word(day, 1, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
|
|
CALL dos_std_string_out(@('Setting new date',CR,LF,24h));
|
|
date2.day = 17;
|
|
date2.month = 3;
|
|
date2.year = 1987;
|
|
err = dos_set_date(@date2);
|
|
day = dos_get_date(@date2);
|
|
CALL error_if(err <> 0 OR date2.day <> 17
|
|
OR date2.month <> 3 OR date2.year <> 1987);
|
|
CALL error_if (dos_set_date(@date1) <> 0);
|
|
END;
|
|
|
|
|
|
/* Get/Set Time Test */
|
|
|
|
DO;
|
|
DECLARE time1 STRUCTURE(
|
|
hundredeths BYTE,
|
|
seconds BYTE,
|
|
minutes BYTE,
|
|
hours BYTE);
|
|
DECLARE time2 STRUCTURE(
|
|
hundredeths BYTE,
|
|
seconds BYTE,
|
|
minutes BYTE,
|
|
hours BYTE);
|
|
DECLARE ch1 BYTE;
|
|
CALL dos_std_string_out(@('<> Test Get/Set Time',CR,LF,24h));
|
|
CALL dos_std_string_out(
|
|
@('Time will display until you press ENTER',CR,LF,24h));
|
|
DO WHILE (ch1 := dos_direct_in) = 0FFh;
|
|
CALL dos_get_time(@time1);
|
|
CALL print_time(@time1, TRUE);
|
|
CALL dos_std_out(CR);
|
|
END;
|
|
CALL dos_std_string_out(@CRLF);
|
|
|
|
CALL dos_std_string_out(@('Setting time to 23:10:05:00',CR,LF,24h));
|
|
CALL dos_get_time(@time1);
|
|
time2.hours = 23;
|
|
time2.minutes = 10;
|
|
time2.seconds = 5;
|
|
time2.hundredeths = 0;
|
|
CALL error_if(dos_set_time(@time2) <> 0);
|
|
CALL dos_get_time(@time2);
|
|
CALL dos_std_string_out(@('Time returned is ',24h));
|
|
CALL print_time(@time2, TRUE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL error_if(dos_set_time(@time1) <> 0);
|
|
END;
|
|
|
|
|
|
/* Verify Test */
|
|
|
|
DO;
|
|
DECLARE (old_mode, mode) BYTE;
|
|
CALL dos_std_string_out(@('<> Test Verify Get/Set',CR,LF,24h));
|
|
old_mode = dos_get_verify;
|
|
CALL dos_std_string_out(@('Current mode: ',24h));
|
|
CALL dos_std_out('0' + old_mode);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL dos_std_string_out(@('Setting checking on',CR,LF,24h));
|
|
CALL dos_set_verify(1);
|
|
CALL error_if(dos_get_verify <> 1);
|
|
CALL dos_std_string_out(@('Setting checking off',CR,LF,24h));
|
|
CALL dos_set_verify(0);
|
|
CALL error_if(dos_get_verify <> 0);
|
|
CALL dos_set_verify(old_mode);
|
|
END;
|
|
|
|
|
|
/* Ctrl-Break Check Test */
|
|
|
|
DO;
|
|
DECLARE (old_mode, mode) BYTE;
|
|
CALL dos_std_string_out(@('<> Test Ctrl-Break Check Get/Set',CR,LF,24h));
|
|
old_mode = dos_get_ctrl_break;
|
|
CALL dos_std_string_out(@('Current mode: ',24h));
|
|
CALL dos_std_out('0' + old_mode);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL dos_std_string_out(@('Setting checking on',CR,LF,24h));
|
|
CALL dos_set_ctrl_break(1);
|
|
CALL error_if(dos_get_ctrl_break <> 1);
|
|
CALL dos_std_string_out(@('Setting checking off',CR,LF,24h));
|
|
CALL dos_set_ctrl_break(0);
|
|
CALL error_if(dos_get_ctrl_break <> 0);
|
|
CALL dos_set_ctrl_break(old_mode);
|
|
END;
|
|
|
|
|
|
/* Get/Set Interrupt Vector Test */
|
|
|
|
DO;
|
|
DECLARE (old_vector, vector) DWORD;
|
|
DECLARE handler_ptr DWORD;
|
|
DECLARE handler_off WORD AT(.handler_ptr);
|
|
DECLARE handler_seg SELECTOR AT(.handler_ptr+2);
|
|
CALL dos_std_string_out(@('<> Test Get/Set Interrupt Vector',CR,LF,24h));
|
|
old_vector = dos_get_vector(int);
|
|
handler_off = .int_proc;
|
|
handler_seg = dos_get_cs;
|
|
CALL dos_set_vector(int, handler_ptr);
|
|
CALL error_if(handler_ptr <> dos_get_vector(int));
|
|
CALL dos_std_string_out(@('Testing Interrupt Procedure',CR,LF,24h));
|
|
int_count = 0;
|
|
CAUSE$INTERRUPT(int);
|
|
CALL error_if(int_count <> 1);
|
|
CALL dos_set_vector(int, old_vector);
|
|
END;
|
|
|
|
|
|
/* Get disk free space test */
|
|
|
|
DO;
|
|
DECLARE info STRUCTURE (
|
|
avail_clusters WORD,
|
|
total_clusters WORD,
|
|
bytes_sector WORD,
|
|
sectors_cluster WORD);
|
|
CALL dos_std_string_out(@('<> Test Get Disk Free Space',CR,LF,24h));
|
|
CALL dos_std_string_out(@('Testing illegal drive: F',CR,LF,24h));
|
|
CALL error_if(dos_get_disk_free_space(6, @info) = 0);
|
|
CALL dos_std_string_out(@('Testing default drive',CR,LF,24h));
|
|
err = dos_get_disk_free_space(0, @info);
|
|
CALL error_if(err <> 0);
|
|
IF err = 0 THEN
|
|
DO;
|
|
CALL dos_std_string_out(@(' Available clusters: ',24h));
|
|
CALL print_word(info.avail_clusters, 5, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL dos_std_string_out(@(' Total clusters: ',24h));
|
|
CALL print_word(info.total_clusters, 5, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL dos_std_string_out(@(' Bytes per sector: ',24h));
|
|
CALL print_word(info.bytes_sector, 5, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL dos_std_string_out(@(' Sectors per cluster: ',24h));
|
|
CALL print_word(info.sectors_cluster, 5, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
END;
|
|
CALL dos_std_string_out(@('Testing drive A',CR,LF,24h));
|
|
err = dos_get_disk_free_space(1, @info);
|
|
CALL error_if(err <> 0);
|
|
IF err = 0 THEN
|
|
DO;
|
|
CALL dos_std_string_out(@(' Available clusters: ',24h));
|
|
CALL print_word(info.avail_clusters, 5, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL dos_std_string_out(@(' Total clusters: ',24h));
|
|
CALL print_word(info.total_clusters, 5, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL dos_std_string_out(@(' Bytes per sector: ',24h));
|
|
CALL print_word(info.bytes_sector, 5, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL dos_std_string_out(@(' Sectors per cluster: ',24h));
|
|
CALL print_word(info.sectors_cluster, 5, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
END;
|
|
END;
|
|
|
|
|
|
/* Create/Remove/Change/Get Directory Test */
|
|
|
|
DO;
|
|
DECLARE buffer (64) BYTE;
|
|
CALL dos_std_string_out(@('<> Test Directory Management',CR,LF,24h));
|
|
CALL error_if_not_zero(dos_get_dir(0, @buffer));
|
|
CALL dos_std_string_out(@('Current directory: ',24h));
|
|
CALL print_string(@buffer);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL error_if_not_zero(dos_create_dir(@('@@funny@',0)));
|
|
CALL error_if_not_zero(dos_change_dir(@('@@funny@',0)));
|
|
CALL error_if_not_zero(dos_get_dir(0, @buffer));
|
|
CALL dos_std_string_out(@('Current directory: ',24h));
|
|
CALL print_string(@buffer);
|
|
CALL dos_std_string_out(@CRLF);
|
|
CALL error_if_not_zero(dos_change_dir(@('..',0)));
|
|
CALL error_if_not_zero(dos_delete_dir(@('@@funny@',0)));
|
|
END;
|
|
|
|
|
|
/* File I/O test */
|
|
|
|
DO;
|
|
DECLARE (f1, f2) WORD;
|
|
DECLARE k WORD;
|
|
DECLARE BUF_SIZE LITERALLY '1024';
|
|
DECLARE FILE_SIZE LITERALLY '64';
|
|
DECLARE buf1 (BUF_SIZE) WORD;
|
|
DECLARE buf2 (BUF_SIZE) WORD;
|
|
DECLARE n WORD;
|
|
DECLARE (p1, p2) DWORD;
|
|
k = 0;
|
|
DO WHILE k < BUF_SIZE;
|
|
buf1(k) = k;
|
|
k = k + 1;
|
|
END;
|
|
|
|
CALL dos_std_string_out(@('<> Test File I/O',CR,LF,24h));
|
|
|
|
CALL dos_std_string_out(@('Creating: FILE0000.TMP',CR,LF,24h));
|
|
CALL error_if_not_zero(dos_create(@f1, @('FILE0000.TMP',0), 0));
|
|
CALL dos_std_string_out(@('Writing to file',CR,LF,24h));
|
|
k = 0;
|
|
DO WHILE k < FILE_SIZE;
|
|
buf1(0) = k + BUF_SIZE;
|
|
err = dos_write(f1, @buf1, SIZE(buf1), @n);
|
|
CALL error_if(err <> 0 OR n < SIZE(buf1));
|
|
k = k + 1;
|
|
END;
|
|
CALL dos_std_string_out(@('Seeking from end to check file size',CR,LF,24h));
|
|
err = dos_seek(f1, SEEK_FROM_END, 0, @p1);
|
|
p2 = FILE_SIZE;
|
|
p2 = p2 * SIZE(buf1);
|
|
CALL error_if(err <> 0 OR p1 <> p2);
|
|
CALL dos_std_string_out(@('Closing file',CR,LF,24h));
|
|
CALL error_if_not_zero(dos_close(f1));
|
|
|
|
CALL dos_std_string_out(@('Opening: FILE0000.TMP',CR,LF,24h));
|
|
CALL error_if_not_zero(dos_open(@f1, @('FILE0000.TMP',0), OPEN_READ_ONLY));
|
|
CALL dos_std_string_out(@('Reading file',CR,LF,24h));
|
|
k = 0;
|
|
DO WHILE k < FILE_SIZE;
|
|
buf1(0) = k + BUF_SIZE;
|
|
err = dos_read(f1, @buf2, SIZE(buf2), @n);
|
|
CALL error_if( err <> 0
|
|
OR n < SIZE(buf2)
|
|
OR cmpb(@buf1, @buf2, SIZE(buf1)) <> 0FFFFh);
|
|
k = k + 1;
|
|
END;
|
|
|
|
CALL dos_std_string_out(@('Seeking absolute',CR,LF,24h));
|
|
p1 = SIZE(buf1);
|
|
p1 = p1 * 13;
|
|
err = dos_seek(f1, SEEK_FROM_BEG, p1, @p2);
|
|
CALL error_if(err <> 0 OR p1 <> p2);
|
|
buf1(0) = 13 + BUF_SIZE;
|
|
err = dos_read(f1, @buf2, SIZE(buf2), @n);
|
|
CALL error_if( err <> 0
|
|
OR n < SIZE(buf2)
|
|
OR cmpb(@buf1, @buf2, SIZE(buf1)) <> 0FFFFh);
|
|
|
|
CALL dos_std_string_out(@('Seeking relative',CR,LF,24h));
|
|
p1 = SIZE(buf1);
|
|
p1 = p1 * 40;
|
|
err = dos_seek(f1, SEEK_RELATIVE, p1, @p2);
|
|
p1 = SIZE(buf1);
|
|
p1 = p1 * (40 + 14);
|
|
CALL error_if(err <> 0 OR p1 <> p2);
|
|
buf1(0) = 54 + BUF_SIZE;
|
|
err = dos_read(f1, @buf2, SIZE(buf2), @n);
|
|
CALL error_if( err <> 0
|
|
OR n < SIZE(buf2)
|
|
OR cmpb(@buf1, @buf2, SIZE(buf1)) <> 0FFFFh);
|
|
|
|
CALL dos_std_string_out(@('Closing file',CR,LF,24h));
|
|
CALL error_if_not_zero(dos_close(f1));
|
|
|
|
CALL dos_std_string_out(
|
|
@('Renaming FILE0000.TMP to FILE0001.TMP',CR,LF,24h));
|
|
CALL error_if_not_zero(dos_rename(@('FILE0000.TMP',0), @('FILE0001.TMP',0)));
|
|
|
|
CALL dos_std_string_out(@('Deleting: FILE0001.TMP',CR,LF,24h));
|
|
CALL error_if_not_zero(dos_delete(@('FILE0001.TMP',0)));
|
|
END;
|
|
|
|
|
|
/* Get/Set file attribute Test */
|
|
|
|
DO;
|
|
DECLARE (attr1, attr2) WORD;
|
|
DECLARE (f1) WORD;
|
|
|
|
/* This test causes problems when accessing files over a network, so it
|
|
is commented out for now. The problems occur on OpenNET with DOS 3.10,
|
|
iNDX 3.0 with OpenNET upgrade, and PC-LINK 1.0. This comment may be
|
|
removed when testing this sample program under some other environment.
|
|
|
|
CALL dos_std_string_out(@('<> Test Get/Set file attribute',CR,LF,24h));
|
|
CALL dos_std_string_out(@('Creating READ_ONLY, HIDDEN file',CR,LF,24h));
|
|
attr1 = ATTR_READ_ONLY + ATTR_HIDDEN;
|
|
CALL error_if_not_zero(dos_create(@f1, @('FILE0000.TMP',0), attr1));
|
|
CALL error_if_not_zero(dos_close(f1));
|
|
CALL dos_std_string_out(@('Deleting READ_ONLY, HIDDEN file',CR,LF,24h));
|
|
CALL error_if(dos_delete(@('FILE0000.TMP',0)) = 0);
|
|
err = dos_get_attribute(@('FILE0000.TMP',0), @attr2);
|
|
CALL error_if(err <> 0 OR (attr1 <> (attr1 AND attr2)));
|
|
attr1 = 0;
|
|
CALL error_if_not_zero(dos_set_attribute(@('FILE0000.TMP',0), attr1));
|
|
err = dos_get_attribute(@('FILE0000.TMP',0), @attr2);
|
|
CALL error_if(err <> 0 OR attr1 <> attr2);
|
|
CALL error_if_not_zero(dos_delete(@('FILE0000.TMP',0)));
|
|
*/
|
|
END;
|
|
|
|
|
|
/* Allocate/Free/Modify Memory Test */
|
|
|
|
DO;
|
|
DECLARE (s1, s2) SELECTOR;
|
|
DECLARE (available_size, error) WORD;
|
|
|
|
CALL dos_std_string_out(@('<> Test Allocate/Free/Modify Memory',CR,LF,24h));
|
|
|
|
CALL error_if((error := dos_allocate(@s1, 0F000h, @available_size)) = 0);
|
|
IF error = 0 THEN
|
|
DO;
|
|
CALL dos_std_string_out(@('Memory error',CR,LF,24h));
|
|
GOTO exit;
|
|
END;
|
|
|
|
CALL dos_std_string_out(@('Largest available block: ',24h));
|
|
CALL print_word(available_size, 5, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
|
|
IF available_size < 2000h THEN
|
|
DO;
|
|
/* Assume some memory can be freed from this program's block */
|
|
/* Note that this block of code is designed to handel the case
|
|
where the EXE file is produced by DOS's LINK program, since
|
|
it allocates all memory in a single block with the Program
|
|
Segment Prefix as the selector. This does not work when
|
|
the EXE file is produced by the UDI2DOS program. That is why
|
|
we first test to see if memory is free or not.
|
|
*/
|
|
psps = dos_get_psp;
|
|
CALL error_if_not_zero(
|
|
error := dos_set_block(psps, 1000h, @available_size));
|
|
IF error > 0 THEN
|
|
DO;
|
|
CALL dos_std_string_out(
|
|
@('Insufficient memory to test allocation',CR,LF,24h));
|
|
GOTO exit;
|
|
END;
|
|
|
|
CALL error_if(
|
|
(error := dos_allocate(@s1, 0F000h, @available_size)) = 0);
|
|
IF error = 0 THEN
|
|
DO;
|
|
CALL dos_std_string_out(@('Memory error',CR,LF,24h));
|
|
GOTO exit;
|
|
END;
|
|
CALL dos_std_string_out(
|
|
@('Largest available block (after freeing): ',24h));
|
|
CALL print_word(available_size, 5, 10, FALSE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
END;
|
|
|
|
CALL error_if_not_zero(dos_allocate(@s2, 2000h, @available_size));
|
|
CALL error_if_not_zero(dos_set_block(s2, 800h, @available_size));
|
|
CALL error_if_not_zero(dos_set_block(s2, 1000h, @available_size));
|
|
CALL error_if_not_zero(dos_free(s2));
|
|
|
|
exit:
|
|
END;
|
|
|
|
|
|
/* EXEC Test */
|
|
|
|
DO;
|
|
DECLARE exec_parameter_block STRUCTURE(
|
|
envs SELECTOR,
|
|
command DWORD,
|
|
fcb1 DWORD,
|
|
fcb2 DWORD);
|
|
DECLARE dw STRUCTURE(off WORD, seg SELECTOR);
|
|
DECLARE d DWORD AT(.dw);
|
|
DECLARE paragraphs_free WORD;
|
|
DECLARE s SELECTOR;
|
|
DECLARE exit_code WORD;
|
|
|
|
CALL dos_std_string_out(@('<> Test EXEC',CR,LF,24h));
|
|
|
|
CALL error_if(dos_allocate(@s, 0F000h, @paragraphs_free) = 0);
|
|
IF paragraphs_free < 1000h /* 64K */ THEN
|
|
DO;
|
|
CALL dos_std_string_out(
|
|
@('Insufficient memory to test EXEC',CR,LF,24h));
|
|
END;
|
|
ELSE
|
|
DO;
|
|
psps = dos_get_psp;
|
|
exec_parameter_block.envs = psp.envs;
|
|
dw.off = 0;
|
|
dw.seg = 0;
|
|
exec_parameter_block.fcb1 = d;
|
|
exec_parameter_block.fcb2 = d;
|
|
dw.seg = dos_get_ds;
|
|
dw.off = .(12,'/C CHKDSK A:',13);
|
|
exec_parameter_block.command = d;
|
|
|
|
CALL error_if_not_zero(dos_exec(EXEC_EXEC, @('C:\COMMAND.COM',0), @exec_parameter_block));
|
|
CALL dos_std_string_out(@('Exit code returned by EXEC: ',24h));
|
|
exit_code = dos_wait;
|
|
CALL print_word(exit_code, 4, 16, TRUE);
|
|
CALL dos_std_string_out(@CRLF);
|
|
END;
|
|
END;
|
|
|
|
|
|
/* Search Directory Test */
|
|
|
|
DO;
|
|
DECLARE dta (128) BYTE;
|
|
DECLARE file STRUCTURE(
|
|
reserved (21) BYTE,
|
|
attr BYTE,
|
|
time WORD,
|
|
date WORD,
|
|
size DWORD,
|
|
name (13) BYTE) AT (.dta);
|
|
DECLARE date STRUCTURE(
|
|
day BYTE,
|
|
month BYTE,
|
|
year WORD);
|
|
DECLARE time STRUCTURE(
|
|
hundredeths BYTE,
|
|
seconds BYTE,
|
|
minutes BYTE,
|
|
hours BYTE);
|
|
DECLARE ERR_NO_MORE_FILES LITERALLY '18';
|
|
CALL dos_std_string_out(@('<> Test Directory Search',CR,LF,24h));
|
|
CALL dos_set_disk_transfer_address(@dta);
|
|
err = dos_find_first(@any_name, 0);
|
|
CALL error_if_not_zero(err);
|
|
DO WHILE err = 0;
|
|
date.day = (file.date AND 0001Fh);
|
|
date.month = SHR(file.date AND 001E0h, 5);
|
|
date.year = SHR(file.date AND 0FE00h, 9) + 1980;
|
|
CALL print_date(@date);
|
|
CALL dos_std_string_out(@(' ',24h));
|
|
time.hundredeths = 0;
|
|
time.seconds = SHL(file.time AND 0001Fh, 1);
|
|
time.minutes = SHR(file.time AND 007E0h, 5);
|
|
time.hours = SHR(file.time AND 0F800h, 11);
|
|
CALL print_time(@time, FALSE);
|
|
CALL dos_std_string_out(@(' ',24h));
|
|
CALL print_dword(file.size, 10, 10, FALSE);
|
|
CALL dos_std_string_out(@(' ',24h));
|
|
CALL print_string(@file.name);
|
|
CALL dos_std_string_out(@CRLF);
|
|
err = dos_find_next(@any_name);
|
|
END;
|
|
CALL error_if(err <> ERR_NO_MORE_FILES);
|
|
END;
|
|
|
|
|
|
/* Exit */
|
|
|
|
CALL dos_std_string_out(@('<> Normal Exit',CR,LF,24h));
|
|
CALL dos_exit(error_status);
|
|
|
|
END;
|