$TITLE ('TAKE - ROUTINES TO IMPLEMENT THE "TAKE" COMMAND') take$module: /* COPYRIGHT (C) 1985, Trustees of Columbia University in the City of New */ /* York. Permission is granted to any individual or institution to use, */ /* copy, or redistribute this software so long as it is not sold for */ /* profit, provided this copyright notice is retained. */ /* Contains the following public routines: */ /* take, takehelp, takeini, takeline */ do; /* Global declarations */ declare true literally '0FFH'; declare false literally '00H'; declare space literally '020H'; declare cr literally '0DH'; declare lf literally '0AH'; declare null literally '00H'; declare crlf literally 'cr,lf,null'; declare readonly literally '1'; declare noedit literally '0'; declare def$drive(5) byte external; /* the default local drive */ declare debug byte external; declare taking byte external; /* TRUE if TAKE in effect */ declare takeeof byte initial(false); declare lasttake byte initial(false); declare takefile(15) byte; /* full name of the take file */ declare (jfn, status) address; declare tbufsize literally '128'; /* Size of the TAKE file buffer */ declare takebuff(tbufsize) byte; declare (nextchar, lastchar) byte; /* Subroutines */ co: procedure(char) external; declare char byte; end co; print: procedure(string) external; declare string address; end print; ci: procedure byte external; end ci; open: procedure(jfn, filenm, access, mode, status) external; declare (jfn, filenm, access, mode, status) address; end open; read: procedure(jfn, buffer, count, actual, status) external; declare (jfn, buffer, count, actual, status) address; end read; close: procedure(jfn, status) external; declare (jfn, status) address; end close; ready: procedure(port) byte external; declare (port) byte; end ready; newline: procedure external; end newline; token: procedure address external; end token; upcase: procedure (addr) external; declare addr address; end upcase; movevar: procedure(offset, source, dest) byte external; declare offset byte; declare (source, dest) address; end movevar; /* Close the TAKE file */ closetake: procedure; call close(jfn, .status); if status > 0 then call print(.('\Unable to close TAKE file\$')); end closetake; /* Fill the TAKE buffer with the next block from the TAKE file */ filltbuf: procedure; declare count address; call read(jfn, .takebuff, tbufsize, .count, .status); if status > 0 then do; call print(.('Error reading TAKE file\$')); takeeof = true; end; else do; if count < tbufsize then lasttake = true; nextchar = 0; lastchar = count - 1; end; end filltbuf; /* TAKECHAR: Return to the caller a character from the TAKE file */ /* buffer. This routine discards nulls but returns all other */ /* characters. It returns a zero on end-of-file. */ takechar: procedure byte; declare retbyte byte; retbyte = 0; do while (retbyte = 0 and takeeof = false); if nextchar > lastchar then do; /* The current buffer contents is exhausted */ if lasttake then /* This is the last (short) block */ takeeof = true; call filltbuf; /* Refill the buffer */ if nextchar > lastchar then /* No more data */ takeeof = true; end; if takeeof then retbyte = 0; else do; retbyte = takebuff(nextchar); nextchar = nextchar + 1; end; end; return retbyte; end takechar; /* TAKELINE: Return to the caller a command line from the TAKE file. */ /* This routine closes the TAKE file and resets TAKE mode on end */ /* of file. */ takeline: procedure (bufaddr) public; declare bufaddr address; declare bufstart address; declare bufchr based bufaddr byte; declare nextbyte byte; bufstart = bufaddr; /* Save start of buffer */ nextbyte = takechar; do while (nextbyte <> 0 and nextbyte <> cr); bufchr = nextbyte; bufaddr = bufaddr + 1; nextbyte = takechar; end; bufchr = 0; /* Set stopper */ if nextbyte = cr then nextbyte = takechar; /* Discard LF */ /* Search for a semicolon (comment delimiter) in the TAKE file */ /* command line */ bufaddr = bufstart; do while (bufchr <> ';' and bufchr <> null); bufaddr = bufaddr + 1; end; if bufchr = ';' then /* Found a semicolon */ /* Truncate the command at the semicolon in the following */ /* cases: (1) The delimiter occurs in the 1st position of */ /* record. (2) The delimiter is preceded by a blank. */ do; if bufaddr = bufstart then bufchr = null; else do; bufaddr = bufaddr - 1; /* Check previous byte */ if bufchr = space then bufchr = null; end; end; if takeeof then do; call closetake; taking = false; end; end takeline; /* Initialize Kermit to take from the file KERMIT.INI */ takeini: procedure public; declare dummy byte; dummy = movevar(0,.('KERMIT.INI',null),.takefile); /* Set up name */ call open(.jfn, .takefile, readonly, noedit, .status); if (status = 0) then do; taking = true; lasttake = false; takeeof = false; call filltbuf; end; end takeini; /* Display help for the TAKE command */ takehelp: procedure public; call print(.('\TAKE\\$')); call print(.(' The TAKE command causes Kermit to read commands $')); call print(.('from a specified file.\\$')); call print(.('Syntax:\\$')); call print(.(' TAKE file\\$')); call print(.('If a TAKE command is encountered within a TAKE file, $')); call print(.('the old TAKE file \$')); call print(.('will be closed and the new one opened.\\$')); end takehelp; take: procedure public; declare filename address; declare foffset byte; declare fnptr address; declare fnchr based fnptr byte; filename = token; if (filename = 0) then call print(.('TAKE file not specified.\$')); else do; if taking then do; /* Close the prior TAKE file */ call closetake; taking = false; end; call upcase(filename); /* Crack the file name */ fnptr = filename; if fnchr = ':' then do; /* File name on command has a drive */ foffset = movevar(0,filename,.takefile); /* Use file name as-is */ end; else do; foffset = movevar(0,.def$drive,.takefile); /* Build local file name */ foffset = movevar(foffset,filename,.takefile); /* from default drive */ end; if debug then do; call print(.(cr,lf,'TAKE file name is: $')); call print(.takefile); call newline; end; /* debug */ call open(.jfn, .takefile, readonly, noedit, .status); if (status > 0) then do; call print(.(cr,lf,'Cannot open TAKE file ',null)); call print(.takefile); call print(.(crlf)); end; else do; taking = true; lasttake = false; takeeof = false; call filltbuf; end; end; end take; end take$module;