home *** CD-ROM | disk | FTP | other *** search
- ch1: proc options(main); /* chain subroutine tester */
-
- dcl fcbptr ptr;
-
- dcl 1 fcb based(fcbptr),
- 2 drive fixed(7),
- 2 name char(8),
- 2 type char(3),
- 2 ext(4) fixed(7),
-
- dummy char(16) based(fcbptr);
-
- dcl
- chain entry(char(16)),
- fparse entry(ptr,ptr,fixed(7));
-
-
- dcl
- UPPERCASE char(26) static init('ABCDEFGHIJKLMNOPQRSTUVWXYZ'),
- LOWERCASE char(26) static init('abcdefghijklmnopqrstuvwxyz'),
- filename char(14),
- retcode fixed(7);
-
- /* base fcb at default fcb (5CH) */
- unspec(fcbptr) = '005C'b4;
-
- put skip list('Executing Chain Test');
- if fcb.name = '' then do;
- put skip list
- ('Chain to ..............^H^H^H^H^H^H^H^H^H^H^H^H^H^H');
- get list (filename);
- filename = translate(filename,UPPERCASE,LOWERCASE);
- call fparse(addr(filename),fcbptr,retcode);
- if retcode > 1 then
- put skip(2) list('Invalid Filename');
- end;
- fcb.type = 'COM';
- call chain(dummy);
- put skip(2) list('Shouldn''t be here !!');
- end ch1;
-