# This is a shell archive.  Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by davea at hpfcmt on Tue Nov 24 14:42:59 1987
#
# This archive contains:
#	PAWS.SID.Demos	
#

echo mkdir - PAWS.SID.Demos
mkdir PAWS.SID.Demos

echo x - PAWS.SID.Demos/AVDHANGS1
cat >PAWS.SID.Demos/AVDHANGS1 <<'@EOF'
program AvoidHangs1(keyboard, output);
import uio;
var
  keyboard:             text;
  Character:            char;
  I:                    integer;
begin
writeln(output,'Press any key.  Hurry!');
for I:=1 to 3000 do
  begin
  if not unitbusy(2) then                {"busy" means typeahead buffer empty}
    begin
    writeln(output,'You beat me!');
    read(keyboard,Character);              {eat character in typeahead buffer}
    halt;                               {stop here; don't print other message}
    end;
  end;
writeln(output,'Guess I was too fast for you.');
end.
@EOF

chmod 666 PAWS.SID.Demos/AVDHANGS1

echo x - PAWS.SID.Demos/AVDHANGS2
cat >PAWS.SID.Demos/AVDHANGS2 <<'@EOF'
program AvoidHangs2(keyboard, output);
import uio,sysdevs;
const
  TimeLimit=            200;                    {200 centiseconds = 2 seconds}
var
  keyboard:             text;
  Character:            char;
  Start:                integer;
  GotOne:               boolean;
begin
writeln(output,'Press any key within two seconds!');
Start:=sysclock;
GotOne:=false;
repeat
  if not unitbusy(2) then                {"busy" means typeahead buffer empty}
    begin
    writeln(output,'You beat me!');
    read(keyboard, Character);     {eat the character in the typeahead buffer}
    GotOne:=true;
    end;
until GotOne or (sysclock>(Start+TimeLimit));
if not GotOne then
  writeln(output,#G,'Wow, you ARE slow!');
end.
@EOF

chmod 666 PAWS.SID.Demos/AVDHANGS2

echo x - PAWS.SID.Demos/BTEST
cat >PAWS.SID.Demos/BTEST <<'@EOF'
*
* EXAMPLE OF A MINIMAL BOOTABLE PROGRAM FOR 9826/9836
*
        rorg    -15000          default load address 
*                               can be changed by linking 

        start   *               beginning execution address 

        lea     msg,a0          a0 indexes message 

        lea     $5121A0,a1      a1 indexes CRT memory, 80 cols
*       lea     $512704,a1      a1 indexes CRT memory, 50 cols

        moveq   #0,d1           clear highlight byte 
again   move.b  (a0)+,d1        move message byte into register
        beq     *               infinite idle loop when finished 
        move.w  d1,(a1)+        move highlight, character to screen 
        bra     again           repeat 

msg     dc.b    'Hello, this is a message.',0
        
        nosyms                  no symbol table dump, please 
        end
@EOF

chmod 666 PAWS.SID.Demos/BTEST

echo x - PAWS.SID.Demos/CURSORSW
cat >PAWS.SID.Demos/CURSORSW <<'@EOF'
$sysprog$
program cursorsw (input,output);
var
  regselect [hex('510001')]:    char;
  crtreg    [hex('510003')]:    char;
  reg,byte:  char;
  x: integer;
  instr: string[50];

{    Note:  the compiler accesses type 'char' as a byte, 
     but type '0..255' as a word; it won't make an 
     unsigned subrange.                                  }

begin
  repeat
    writeln;
    write('What register number (enter in decimal)? ');  
    readln(x);  
    if (x<10) or (x>15) then writeln('Bad register number')
    else
      begin
        reg := chr(x);
        write('Write what value (enter 8-bit binary pattern)? ');
        readln(instr);  byte := chr(binary(instr));
        regselect := reg;
        crtreg := byte;
      end;
  until not true;
end.
@EOF

chmod 666 PAWS.SID.Demos/CURSORSW

echo x - PAWS.SID.Demos/DUMMYINIT
cat >PAWS.SID.Demos/DUMMYINIT <<'@EOF'
$SYSPROG ON$
(***************************************************************)
(*                                                             *)
(*                                                             *)
(*      IOLIB           example drivers                        *)
(*                                                             *)
(*                                                             *)
(***************************************************************)
(*                                                             *)
(*                                                             *)
(*      library      -  IOLIB                                  *)
(*      name         -  DUMMY                                  *)
(*      module(s)    -  extd                                   *)
(*                   -  init_dummy                             *)
(*                   -  dummy_initialize                       *)
(*                                                             *)
(*      date         -  July 21 , 1982                         *)
(*      update       -  July 21 , 1982                         *)
(*                                                             *)
(***************************************************************)

PROGRAM dummy_initialize (INPUT , OUTPUT);
        { This module has a program segment so that there is
          an executable entry point into the module.
          At INITLIB time this program is executed. }

MODULE extd;
IMPORT  sysglobals , iodeclarations ;  
EXPORT
  PROCEDURE ed_init  (temp : ANYPTR);
  PROCEDURE ed_rdb   (temp : ANYPTR ;  VAR x : CHAR);
  PROCEDURE ed_wtb   (temp : ANYPTR ;  val   : CHAR);
  PROCEDURE ed_send  (temp : ANYPTR ;  val   : CHAR);
IMPLEMENT

  PROCEDURE ed_init  (temp : ANYPTR);
  BEGIN
    WRITELN('INITIALIZATION  on ',io_find_isc(temp):4);
  END;
  
  PROCEDURE ed_rdb   (temp : ANYPTR ;  VAR x : CHAR);
  BEGIN
    WRITELN('READ CHARACTER  on ',io_find_isc(temp):4);
    READ(x);
  END;
  
  PROCEDURE ed_wtb   (temp : ANYPTR ;  val   : CHAR);
  BEGIN
    WRITELN('WRITE CHARACTER on ',io_find_isc(temp):4);
    WRITE(val);
  END;
  
  PROCEDURE ed_send  (temp : ANYPTR ;  val   : CHAR);
  BEGIN
    WRITELN('SEND COMMAND    on ',io_find_isc(temp):4,
            ' of command ',ORD(val):3);
  END;
END; { of extd }


MODULE init_dummy ; { This module initializes the HPIB drivers. }
IMPORT    sysglobals , isr , general_0 , extd, iodeclarations ;  
EXPORT
  CONST dummy_id    = -100;
        dummy_type  =  100;
  VAR my_dummy_drivers  : drv_table_type;
  PROCEDURE io_init_dummy;
IMPLEMENT
  
  PROCEDURE io_init_dummy;
  VAR io_isc        : type_isc;
      dummy         : INTEGER;
      io_lvl        : io_byte;
  BEGIN
    io_revid := io_revid + ' DUMMY1.0';     { io_revid indicates 
                                              what version of the 
                                              drivers are in the 
                                              system.  }
    { set up the driver tables }
    WITH my_dummy_drivers DO BEGIN
      my_dummy_drivers := dummy_drivers;    { sets up the table 
                                              with all dummy 
                                              entries }
      iod_init  := ed_init;
      iod_rdb   := ed_rdb;
      iod_wtb   := ed_wtb;
      iod_send  := ed_send;
    END; { of WITH }
    
    { set up drivers for the interfaces }
    FOR io_isc:=iominisc TO iomaxisc DO 
      WITH isc_table[io_isc] DO BEGIN
        IF (card_id = no_id) 
          THEN BEGIN
            card_id := dummy_id;                { put in my id }
            card_type := dummy_type;            { put in my type }
            io_drv_ptr:=ADDR(my_dummy_drivers);
            { link in an ISR here if it is necessary }
          END; { of IF card_id }
      END; { of FOR io_isc WITH isc_table[io_isc] BEGIN }
    
    { call the actual driver initialization }
    { this is separate from the set up code in case
      there are 2 or more cards connected - and generate
      an isr between each other }
    FOR io_isc:=iominisc TO iomaxisc DO 
      WITH isc_table[io_isc] DO 
      IF (card_id = dummy_id)
        THEN BEGIN
          CALL(io_drv_ptr^.iod_init , io_tmp_ptr);
        END; { of WITH IF }
  END; { of io_init_dummy }
END; { of MODULE init_dummy }


IMPORT    init_dummy ;  
BEGIN
  io_init_dummy;
END. { of dummy_initialize }
@EOF

chmod 666 PAWS.SID.Demos/DUMMYINIT

echo x - PAWS.SID.Demos/FILEDEMO
cat >PAWS.SID.Demos/FILEDEMO <<'@EOF'
$debug on$  (*Show line numbers*)

program filedemo (output);
type
  ifile = file of integer;
var
  f: ifile;
  i,j,k: integer;
begin
  
  rewrite(f,'INTFILE');
  for i := 1 to 100 do  
    write(f, (101-i) );
  close(f,'LOCK');
  
  open(f,'INTFILE');
  for i := 100 downto 1 do
    begin
      readdir(f,i,k);
      writeln(output,'Record #',i:3,' = ',k:3);
    end;

  close(f,'PURGE');
end.
@EOF

chmod 666 PAWS.SID.Demos/FILEDEMO

echo x - PAWS.SID.Demos/FILEPACK
cat >PAWS.SID.Demos/FILEPACK <<'@EOF'
$SYSPROG$

module filepack;

import sysglobals, misc, fs, asm;

export
 
 type 
     volumearray = array[1..50] of string[25];

 procedure volumes  (var v: volumearray);
 procedure filecopy (filename1, filename2: fid; format, writeover: boolean);
 procedure duplicate(filename1, filename2: fid; purgeold: boolean);
 procedure change   (filename1, filename2: fid);
 procedure repack   (filename: fid);
 procedure createdir(filename: fid; newname: vid; entries, bytes: integer);
 procedure makefile (filename: fid);
 procedure makedir  (filename: fid);
 procedure remove   (filename: fid);
 procedure prefix   (filename: fid; unitonly, sysvol: boolean);
 procedure startcat (filename: fid;
        var dirname: vid;
        var typeinfo : string;
        var createdate, changedate: daterec;
        var createtime, changetime: timerec;
        var blocksize, phy_size, start_byte, free_bytes, max_files: integer);
 procedure cat(filenumber: integer;
        var filename: tid;
        var typeinfo: string;
        var createdate, changedate: daterec;
        var createtime, changetime: timerec;
        var kind: filekind;
        var eft: shortint;
        var blocksize, logical_size, phy_size, start_byte,
            extension1, extension2: integer);
 procedure endcat;
 procedure startlistpass(filename: fid);
 procedure listattribute(wordnumber: integer; var outstring: string);
 procedure listpassword (wordnumber: integer; var outstring: string);
 procedure changepassword(word: passtype; attrlist: string255);
 procedure endpass;
 function  ioerrmsg(var msg: string):boolean;
 
implement
 
 const
     catlimit  = 200;
 
 type
     buftype   = packed array[0..maxint] of char;
     bigptr    = ^buftype;
     closecode = (keepit, purgeit);
     catarray  = array[0..catlimit] of catentry;
     passarray = array[0..catlimit] of passentry;
     passarayptr = ^passarray;
     
 var
     catfib, passfib: ^fib;
     catentptr      : ^catarray;
     wordlist, optionlist: passarayptr;
     
 {function memavail $alias 'asm_memavail'$ : integer; external;}
 
 function min(a, b: integer): integer;
 begin
  if a<b then
   min := a
  else
   min := b
 end; { min }
 
 function ioerrmsg(var msg: string): boolean;
 begin
  if ioresult=ord(inoerror) then
   ioerrmsg := false
  else
   begin
    ioerrmsg := true;
    getioerrmsg(msg, ioresult);
   end;
 end; { ioerrmsg }
  
 procedure iocheck;
 begin
  if ioresult <> ord(inoerror) then
   escape(-10);
 end; { iocheck }
 
 procedure badio(iocode: iorsltwd);
 begin
  ioresult := ord(iocode);
  escape(-10);
 end; { badio }
 
 function unitnumber(var fvid: vid): boolean;
 var scanning: boolean;
     i: shortint;
 begin
  unitnumber := false;
  zapspaces(fvid);
  if strlen(fvid) > 1 then
   if fvid[1] = '#' then
    begin
     scanning := true;
     i := 2;
     repeat
      if (fvid[i]>='0') and (fvid[i]<='9') then
       i := i + 1
      else
       scanning := false;
     until (i>strlen(fvid)) or not scanning;
     unitnumber := scanning;
    end;
 end; { unitnumber }
 
 function samedevice(unit1, unit2: unitnum): boolean;
 var u: ^unitentry;
 begin
  u := addr(unitable^[unit1]);
  with unitable^[unit2] do
   samedevice := (u^.sc = sc) and (u^.ba = ba) and
                 (u^.du = du) and (u^.dv = dv) and
                 (u^.letter = letter) and
                 (u^.byteoffset = byteoffset);
 end; { samedevice }
 
 procedure anytomem(ffib: fibp; anyvar buffer: bigptr; maxbuf: integer);
 var bufrec   : ^string255;
     bufptr   : ^char;
     leftinbuf: integer;
 begin { anytomem }
  bufptr    := addr(buffer^);
  bufptr^   := chr(0);   { data coming }
  bufrec    := addr(bufptr^,1);
  setstrlen(bufrec^, 0);  { zero length record }
  bufptr    := addr(bufrec^, 1);
  leftinbuf := maxbuf;
  
  with ffib^, unitable^[funit] do
   begin
    call(am, ffib, readtoeol, bufrec^, 255, fpos);
    repeat
     iocheck;  { check result form last readtoeol }
     bufptr    := addr(bufptr^, strlen(bufrec^));
     leftinbuf := leftinbuf - strlen(bufrec^) - 2;
     if strlen(bufrec^) = 255 then
      bufptr := addr(bufptr^, -1)
     else
      begin
       if strlen(bufrec^) = 0 then
        begin  { discard the length byte }
         bufptr    := addr(bufrec^, -1);
         leftinbuf := leftinbuf + 1;
        end;
         
       { check end of line/file }
       call(am, ffib, readbytes, bufptr^, 1, fpos);
       if feoln then
        begin  { end of line }
         bufptr^ := chr(1);
         feoln   := false;
         if ioresult = ord(ieof) then
          bufptr := addr(bufptr^, 1);
        end;  { end of line }
       if ioresult = ord(ieof) then
        begin  { end of file }
         bufptr^  := chr(2);
         ioresult := ord(inoerror);
         feof     := true;
        end;  { end of file }
       iocheck;  { check ioresult from readbytes }
      end;
      if not((leftinbuf < 259) or feof) then
       begin  { set up for then read the next line }
        bufptr  := addr(bufptr^, 1);
        bufptr^ := chr(0);  { data record }
        bufrec  := addr(bufptr^, 1);
        setstrlen(bufrec^, 0);  { zero length record }
        bufptr  := addr(bufrec^, 1);
        call(am, ffib, readtoeol, bufrec^, 255, fpos);
       end;
     until (leftinbuf < 259) or feof;
     bufptr  := addr(bufptr^, 1);
     bufptr^ := chr(3);  { end buffer }
   end;
 end;  { anytomem }
 
 procedure memtoany(anyvar buffer: bigptr;
                           ffib  : fibp);
 var bytes : integer;
     bufptr: ^char;
 begin
  bufptr := addr(buffer^);
  with ffib^, unitable^[funit] do
   begin
    bytes := 0;
    repeat
     bufptr := addr(bufptr^, bytes);
     bytes  := ord(bufptr^);
     bufptr := addr(bufptr^, 1);
     case bytes of
      0: begin  { data bytes }
          bytes  := ord(bufptr^);  { record length }
          bufptr := addr(bufptr^, 1);
          call(am, ffib, writebytes, bufptr^, bytes, fpos);
         end;
      1: begin  { end record }
          call(am, ffib, writeeol, bufptr^, bytes, fpos);
          bytes := 0;
         end;
      2: begin  { end file }
          call(am, ffib, flush, bufptr^, bytes, fpos);
          bytes := -1;
         end;
      3: bytes := -1;  { end of buffer }
      otherwise ioresult := ord(ibadrequest);
     end;  { case }
     iocheck;
    until bytes < 0;
   end;
 end;  { memtoany }
 
 procedure setupfibforfile(var filename      : fid;
                           var lfib          : fib;
                           requireddirectory : boolean);
 var lkind: filekind;
     segs : integer;
 begin
  ioresult := ord(inoerror);
  with lfib do
   if scantitle(filename, fvid, ftitle, segs, lkind) then
    begin
     funit := findvolume(fvid, true);
     if funit = 0 then
      badio(inounit);
     if not ((ioresult = ord(inodirectory))
     and (strlen(ftitle) = 0)
     and (not requireddirectory)) then
      begin
       iocheck;
       if unitnumber(fvid) then
        badio(znodevice);
      end;
     fkind        := lkind;
     feft         := efttable^[lkind];
     fpos         := segs * 512;
     freptcnt     := 0;
     flastpos     := -1;
     fanonymous   := false;
     fmodified    := false;
     fbufchanged  := false;
     fstartaddress:= 0;
     pathid       := -1;
     foptstring   := nil;
     fnosrmtemp   := true;
     flocked      := true;
     feof         := false;
     feoln        := false;
    end
   else
    badio(ibadtitle);
 end;  { setupfibforfile }
 
 procedure closeinfile(var infib: fib);
 begin
  with infib do
   if freadable then
    begin
     fmodified := false;
     call(unitable^[funit].dam, infib, funit, closefile);
     freadable := false;
    end;
 end;  { closeinfile }
 
 procedure closeoutfile(var outfib: fib; option: closecode);
 var coption: damrequesttype;
 begin
  with outfib do
   if fwriteable then
    begin
     case option of
      keepit:  begin
                fmodified := true;
                coption := closefile;
               end;
      purgeit: coption := purgefile;
     end;
     call(unitable^[funit].dam, outfib, funit, coption);
     fwriteable := false;
    end;
  end;  { closeoutfile }
  
 procedure filecopy(filename1, filename2: fid; format, writeover: boolean);
 type fullname = string[vidleng + tidleng + 1];
      ipointer = ^integer;
 var infib, outfib : fib;
     outsize       : integer;
     outfkind      : filekind;
     outeft        : shortint;
     outfstarta    : integer;
     overcreate    : damrequesttype;
     typecode      : integer;
     lheap         : anyptr;
     saveio        : integer;
     saveesc       : integer;
     buf           : bigptr;
     bufsize       : integer;
     movesize      : integer;
 begin  { filecopy }
  mark(lheap);
  if format then
   typecode := -3  { TEXT file }
  else
   typecode := 1;  { DATA file }
  newwords(infib.fwindow, 1);  { buffer variable }
  finitb(infib, infib.fwindow, typecode);
  
  newwords(outfib.fwindow, 1);  { buffer variable }
  finitb(outfib, outfib.fwindow, typecode);
  
  try
   with infib do
    begin
     setupfibforfile(filename1, infib, false);
     if strlen(ftitle) = 0 then
      begin  { volume -> x }
       call(unitable^[funit].dam, infib, funit, openvolume);
       fkind := datafile;
       feft  := efttable^[datafile];
      end
     else
      begin  { file -> x }
       call(unitable^[funit].dam, infib, funit, openfile);
      end;
     iocheck;
     fpos      := 0;
     freadable := true;
     outfkind  := fkind;
     outeft    := feft;
     outsize   := fleof;
     outfstarta:= fstartaddress;
    end;  { with infib }
    
    with outfib do
     begin
      setupfibforfile(filename2, outfib, false);
      if format then
       begin
        fkind   := suffix(ftitle);  { set destination fkind }
        feft    := efttable^[fkind];
        outsize := 0;
       end
      else
       begin
        fkind   := outfkind;
        feft    := outeft;
        if fpos = 0 then  { no size was specified }
         fpos   := outsize;
       end;
      fstartaddress := outfstarta;
      
      if strlen(ftitle) = 0 then
       begin  { x -> volume }
        call(unitable^[funit].dam, outfib, funit, openvolume);
        iocheck;
        if fpeof < outsize then
         badio(inoroom);
       end  { x -> volume }
      else
       begin  { x -> file }
        if writeover then
         overcreate := overwritefile
        else
         overcreate := createfile;
        call(unitable^[funit].dam, outfib, funit, overcreate);
        iocheck;
        if fpeof < outsize then
         begin  { try to stretch file }
          fpos := outsize;
          call(unitable^[funit].dam, outfib, funit, stretchit);
          iocheck;
          if outsize > fpeof then
           badio(inoroom);
         end;
       end;  { x -> file }
      fpos      := 0;
      fwriteable:= true;
     end;  { with outfib }
     
     bufsize := ((memavail - 5000) div 256) * 256;  { save 5k for slop }
     if bufsize < 512 then escape(-2);              { not enough room }
     newwords(buf, bufsize div 2);                  { allocate buffer space }
     if format then
      outsize := -1;
     
     repeat  { move the file }
      with infib do
       if format then
        begin  { formatted filecopy }
         anytomem(addr(infib), buf, bufsize);
         if feof then
          outsize := 0;
        end
       else
        begin  { unformatted filecopy }
         if bufsize > outsize then
          movesize := outsize
         else
          movesize := bufsize;
         call(unitable^[funit].tm, addr(infib), readbytes, buf^, movesize,
              fpos);
         fpos := fpos + movesize;
        end;
      iocheck;
      
      with outfib do
       if format then
        memtoany(buf, addr(outfib))
       else
        begin  {unformatted filecopy }
         call(unitable^[funit].tm, addr(outfib), writebytes,
              buf^, movesize, fpos);
         fpos    := fpos + movesize;
         fleof   := fpos;
         outsize := outsize - movesize;
        end;
     until outsize  = 0;
     
     release(lheap);
     closeinfile(infib);
     closeoutfile(outfib, keepit);
   
  recover
   begin
    release(lheap);
    saveio   := ioresult;
    saveesc  := escapecode;
    closeinfile(infib);
    closeoutfile(outfib, purgeit);
    escape(saveesc);
   end;
 end;  { filecopy }
 
 procedure volumes(var v: volumearray);
 var un : unitnum;
     i  : integer;
     sym: string[3];
 begin
  for un := 1 to maxunit do
   with unitable^[un] do
    begin
     call(dam, uvid, un, getvolumename);
     v[un] := '';
     if (ioresult = ord(inoerror)) and (strlen(uvid) > 0) then
      begin
       if uvid = syvid then
        sym := ' * '
       else
        if uisblkd then
         sym := ' # '
        else
         sym := '   ';
       strwrite(v[un], 1, i, sym, uvid, ':');
      end;
    end;
 end;  { volumes }
 
 procedure repack(filename : fid);
 var infib : fib;
 begin
  with infib do
   begin
    setupfibforfile(filename, infib, true);
    call(unitable^[funit].dam, infib, funit, crunch);
    iocheck;
   end;
 end;  { repack }
 
 procedure opendir(var filename    : fid;
                   var infib       : fib;
                   var dircatentry : catentry);
 begin  { opendir }
  with infib do
   begin
    freadable := false;
    fwindow   := addr(dircatentry);
    setupfibforfile(filename, infib, false);
    if ioresult = ord(inoerror) then
     begin
      call(unitable^[funit].dam, infib, funit, opendirectory);
      iocheck;
      freadable := true;
     end;
   end;
 end;  { opendir }
 
 procedure closedir(var infib : fib);
 begin
  with infib do
   begin
    if freadable then
     begin
      call(unitable^[funit].dam, infib, funit, closedirectory);
      freadable := false;
     end;
   end;
 end;  { closedir }
 
 procedure createdir(filename : fid; newname : vid; entries, bytes : integer);
 var infib          : fib;
     dircatentry    : catentry;
     saveio, saveesc: integer;
 begin  { createdir }
  with infib, dircatentry do
   try
    opendir(filename, infib, dircatentry);
    if ioresult = ord(inodirectory) then
     begin  { no directory, so set up default values }
      setstrlen(cname, 0);      { volume name }
      cpsize  := maxint;        { size in bytes }
      cextra1 := 0;             { number of entries }
     end
    else
     if (strlen(ftitle) > 0) or (cpsize <= 0) then
      badio(ibadrequest);
    closedir(infib);
    cpsize := min(cpsize, ueovbytes(funit));
    if entries >= 0 then        { -1 retains old values }
     cextra1 := entries;        {  0 selects default 
    if bytes > 0 then
     cpsize := bytes;           { -1 retains old value }
    if cpsize = 0 then
     badio(ibadvalue);
    zapspaces(newname);
    if strlen(newname) > 0 then
     cname := newname;          { null retains old name }
    call(unitable^[funit].dam, infib, funit, makedirectory);
    iocheck;
   recover
    begin
     saveio    := ioresult;
     saveesc   := escapecode;
     closedir(infib);
     ioresult  := saveio;
     escape(saveesc);
    end;
 end;  { createdir }
 
 procedure makedir(filename: fid);
 var infib          : fib;
     dircatentry    : catentry;
     saveio, saveesc:integer;
 begin
  with infib, dircatentry do
   try
    opendir(filename, infib, dircatentry);
    iocheck;
    if strlen(ftitle) = 0 then
     badio(idupfile);
    cname := ftitle;
    call(unitable^[funit].dam, infib, funit, makedirectory);
    iocheck;
    closedir(infib);
   recover 
    begin
     saveio  := ioresult;
     saveesc := escapecode;
     closedir(infib);
     ioresult:= saveio;
     escape(saveesc);
    end;
  closedir(infib);
 end;  { makedir }
 
 procedure makefile(filename : fid);
 var outfib : fib;
 begin
  with outfib do
   begin
    setupfibforfile(filename, outfib, true);
    call(unitable^[funit].dam, outfib, funit, createfile);
    iocheck;
    fwriteable := true;
    fleof      := fpeof;  { cause file size to be retained }
    closeoutfile(outfib, keepit);
    iocheck;
   end;  { with }
 end;  { makefile }
 
 procedure endcat;
 begin
  if catfib <> nil then
   begin
    closedir(catfib^);
    release(catfib);
    catfib := nil;
   end;
 end;  { endcat }
 
 procedure startcat(filename : fid;
                    var dirname               : vid;
                    var typeinfo              : string;
                    var createdate, changedate: daterec;
                    var createtime, changetime: timerec;
                    var blocksize, phy_size, start_byte, free_bytes,
                        max_files             : integer);
 var dircatentry : catentry;
     saveio      : integer;
     saveesc     : integer;
 begin  { startcat }
  endcat;
  new(catfib);
  new(catentptr);
  try
   opendir(filename, catfib^, dircatentry);
   iocheck;
   with dircatentry do
    begin
     dirname   := cname;
     typeinfo  := cinfo;
     createdate:= ccreatedate;
     changedate:= clastdate;
     createtime:= ccreatetime;
     changetime:= clasttime;
     blocksize := cblocksize;
     phy_size  := cpsize;
     start_byte:= cstart;
     free_bytes:= cextra2;
     max_files := cextra1;
    end;
   with catfib^, unitable^[funit] do
    begin
     fwindow := addr(catentptr^);
     fpos    := 0;
     fpeof   := catlimit;
     call(dam, catfib^, funit, catalog);
     iocheck;
    end;
  recover
   begin
    saveio   := ioresult;
    saveesc  := escapecode;
    endcat;
    ioresult := saveio;
    escape(saveesc);
   end;
 end;  { startcat }
 
 procedure cat(filenumber :integer;
               var filename               : tid;
               var typeinfo               : string;
               var createdate, changedate : daterec;
               var createtime, changetime : timerec;
               var kind                   : filekind;
               var eft                    : shortint;
               var blocksize, logical_size, phy_size, start_byte,
                   extension1, extension2 : integer);
 begin
  if catfib = nil then escape(-3);
  with catfib^, unitable^[funit] do
   begin
    if not freadable then
     badio(inotopen);
    if (filenumber >= 0) and
     ((filenumber < fpos) or
     ((filenumber >= fpos + catlimit) and (fpeof = catlimit))) then
      begin
       fpos  := filenumber;
       fpeof := catlimit;
       call(dam, catfib^, funit, catalog);
       iocheck;
      end;
    if (filenumber < fpos) or (filenumber >= fpos + fpeof) then
     filename := ''
    else
     with catentptr^[filenumber - fpos] do
      begin
       filename    := cname;
       typeinfo    := cinfo;
       createdate  := ccreatedate;
       changedate  := clastdate;
       createtime  := ccreatetime;
       changetime  := clasttime;
       kind        := ckind;
       eft         := ceft;
       blocksize   := cblocksize;
       logical_size:=clsize;
       phy_size    := cpsize;
       start_byte  := cstart;
       extension1  := cextra1;
       extension2  := cextra2;
      end;
   end;
 end;  { cat }
 
 procedure duplicate(filename1, filename2: fid; purgeold: boolean);
 var infib, outfib   : fib;
     dircatentry     : catentry;
     saveio, saveesc : integer;
 begin
  with infib do
   try
    opendir(filename1, infib, dircatentry);
    iocheck;
    opendir(filename2, outfib, dircatentry);
    iocheck;
    if not samedevice(funit, outfib.funit) then
     badio(ibadrequest);
    fwindow := addr(outfib);
    fpurgeoldlink := purgeold;
    call(unitable^[funit].dam, infib, funit, duplicatelink);
    iocheck;
    closedir(infib);
    closedir(outfib);
   recover
    begin
     saveio  := ioresult;
     saveesc := escapecode;
     closedir(infib);
     closedir(outfib);
     ioresult := saveio;
     if saveesc <> 0 then
      escape(saveesc);
    end;
 end;  { duplicate }
 
 procedure remove(filename: fid);
 var infib : fib;
 begin
  setupfibforfile(filename, infib, true);
  with infib do
   call(unitable^[funit].dam, infib, funit, purgename);
  iocheck;
 end;  { remove }
 
 procedure change(filename1, filename2: fid);
 var infib, outfib : fib;
     lsegs         : integer;
     lkind         : filekind;
 begin
  setupfibforfile(filename1, infib, true);
  with outfib do
   if not scantitle(filename2, fvid, ftitle, lsegs, lkind) then
    badio(ibadtitle);
  with infib do
   if ftitle = '' then
    call(unitable^[funit].dam, outfib.fvid, funit, setvolumename)
   else
    begin
     fwindow := addr(outfib.ftitle);
     call(unitable^[funit].dam, infib, funit, changename);
    end;
  iocheck;
 end;  { change }
 
 procedure endpass;
 begin
  if passfib <> nil then
   release(passfib);
 end;  { endpass }
 
 procedure startlistpass(filename : fid);
 begin
  endpass;
  new(passfib);
  new(wordlist);
  try
   setupfibforfile(filename, passfib^, true);
   with passfib^ do
    begin
     fwindow := addr(wordlist^);
     fpos    := 0;
     fpeof   := catlimit;
     call(unitable^[funit].dam, passfib^, funit, catpasswords);
     iocheck;
     optionlist := addr(foptstring^);
    end;
  recover
   begin
    endpass;
    escape(escapecode);
   end;
 end;  { startlistpass }
 
 procedure listattribute(wordnumber : integer; var outstring : string);
 var i    : integer;
     done : boolean;
 begin
  outstring := '';
  if passfib = nil then
   escape(-3);
  with passfib^ do
   begin
    i    := 0;
    done := false;
    repeat
     with optionlist^[i] do
      begin
       if pbits = 0 then
        done := true
       else
        if i = wordnumber then
         begin
          outstring := pword;
          done      := true;
         end;
       end;
      i := i + 1;
    until done;
    end;
 end;  { listattribute }
 
 procedure listpassword(wordnumber : integer; var outstring : string);
 var i, j, p     : integer;
     first, last : boolean;
 begin
  outstring := '';
  if passfib = nil then
   escape(-3);
  with passfib^ do
   begin
    if (wordnumber >= 0) and
     ((fwindow <> addr(wordlist^)) or
     (wordnumber < fpos) or ((wordnumber >= fpos + catlimit) and 
     (fpeof = catlimit))) then
      begin
       fwindow := addr(wordlist^);
       fpos    := wordnumber;
       fpeof   := catlimit;
       call(unitable^[funit].dam, passfib^, funit, catpasswords);
       iocheck;
      end;
    if (wordnumber >= fpos) and (wordnumber < fpos + fpeof) then
     with wordlist^[wordnumber-fpos] do
      if pbits <> 0 then
       begin
        strwrite(outstring, 1, j, pword, ':');
        first := true;
        last  := false;
        i     := 0;
        p     := pbits;
        repeat
         with optionlist^[i] do
          begin
           last := pbits = 0;
           if not last then
            if iand(pbits, p) = p then
             begin
              if not first then
               strwrite(outstring, strlen(outstring) + 1, j, ',');
              first := false;
              strwrite(outstring, strlen(outstring) + 1, j, pword);
             end;
          end;
         i := i + 1;
        until last;
       end;
   end;
 end;  { listpassword }
 
 procedure changepassword(word: passtype; attrlist: string255);
 var entry  : passentry;
     name   : passtype;
     bits, i: integer;
     found  : boolean;
 begin
  if passfib = nil then
   escape(-3);
  bits := 0;
  zapspaces(attrlist);  { remove blanks and control characters }
  while strlen(attrlist) > 0 do
   begin
    i := strpos(',', attrlist);
    if i = 0 then
     i := strlen(attrlist) + 1;
    name := str(attrlist, 1, i - 1);
    upc(name);  { uppercase the attribute }
    if i > strlen(attrlist) then
     setstrlen(attrlist, 0)
    else
     attrlist := str(attrlist, i + 1, strlen(attrlist) - i);
    i     := 0;
    found := false;
    repeat
     with optionlist^[i] do
      begin
       if pbits = 0 then
        badio(ibadformat);
       if name = pword then
        begin
         found := true;
         bits  := ior(bits, pbits);
        end;
      end;
     i := i + 1;
    until found;
  end;  { get attributes }
  zapspaces(word);
  with entry do
   begin
    pword := word;
    pbits := bits;
   end;
  with passfib^ do
   begin
    fwindow := addr(entry);
    fpos    := 0;
    fpeof   := 1;
    call(unitable^[funit].dam, passfib^, funit, setpasswords);
    iocheck;
   end;
 end;  { changepassword }
 
 procedure prefix(filename: fid; unitonly, sysvol : boolean);
 var i : integer;
     s : vid;
 begin
  zapspaces(filename);
  if unitonly then
   doprefix(filename, s, i, true)
  else
   if sysvol then
    doprefix(filename, syvid, sysunit, true)
   else
    doprefix(filename, dkvid, i, false);
  iocheck;
 end;  { prefix }
 
end.  { module filepack }
   
     
@EOF

chmod 666 PAWS.SID.Demos/FILEPACK

echo x - PAWS.SID.Demos/FOURVOICE
cat >PAWS.SID.Demos/FOURVOICE <<'@EOF'
program Four_voice;
import a804Xdvr;
const
  Voice2F=           '010';                     {R2-R0: voice for frequency}
  Frequency=         '0000011111';              {F9-F0: frequency}
  Voice2A=           '011';                     {R2-R0: voice for attenuation}
  Attenuation=       '0000';                    {A3-A0: attenuation}
  Duration=          '01100100';                {D7-D0: duration}
begin
  sendcmd(hex('E0'));                                   {reset input pointer}
  senddata(binary('1'+Voice2F+str(Frequency,7,4)));     {byte 1}
  senddata(binary('00'+str(Frequency,1,6)));            {byte 2}
  senddata(binary('1'+Voice2A+Attenuation));            {byte 3}
  senddata(binary(Duration));                           {byte 4}
  sendcmd(hex('C4'));                                   {trigger}
end.
@EOF

chmod 666 PAWS.SID.Demos/FOURVOICE

echo x - PAWS.SID.Demos/FP_PSEUDO
cat >PAWS.SID.Demos/FP_PSEUDO <<'@EOF'
*
*  Offsets from "flpt_cardaddr" for the operations to the floating point card.
*
addl_f0_f0      equ     $4000
addl_f0_f2      equ     $4002
addl_f0_f4      equ     $4004
addl_f0_f6      equ     $4006
addl_f2_f0      equ     $4008
addl_f2_f2      equ     $400a
addl_f2_f4      equ     $400c
addl_f2_f6      equ     $400e
addl_f4_f0      equ     $4010
addl_f4_f2      equ     $4012
addl_f4_f4      equ     $4014
addl_f4_f6      equ     $4016
addl_f6_f0      equ     $4018
addl_f6_f2      equ     $401a
addl_f6_f4      equ     $401c
addl_f6_f6      equ     $401e
subl_f0_f0      equ     $4020
subl_f0_f2      equ     $4022
subl_f0_f4      equ     $4024
subl_f0_f6      equ     $4026
subl_f2_f0      equ     $4028
subl_f2_f2      equ     $402a
subl_f2_f4      equ     $402c
subl_f2_f6      equ     $402e
subl_f4_f0      equ     $4030
subl_f4_f2      equ     $4032
subl_f4_f4      equ     $4034
subl_f4_f6      equ     $4036
subl_f6_f0      equ     $4038
subl_f6_f2      equ     $403a
subl_f6_f4      equ     $403c
subl_f6_f6      equ     $403e
mull_f0_f0      equ     $4040
mull_f0_f2      equ     $4042
mull_f0_f4      equ     $4044
mull_f0_f6      equ     $4046
mull_f2_f0      equ     $4048
mull_f2_f2      equ     $404a
mull_f2_f4      equ     $404c
mull_f2_f6      equ     $404e
mull_f4_f0      equ     $4050
mull_f4_f2      equ     $4052
mull_f4_f4      equ     $4054
mull_f4_f6      equ     $4056
mull_f6_f0      equ     $4058
mull_f6_f2      equ     $405a
mull_f6_f4      equ     $405c
mull_f6_f6      equ     $405e
divl_f0_f0      equ     $4060
divl_f0_f2      equ     $4062
divl_f0_f4      equ     $4064
divl_f0_f6      equ     $4066
divl_f2_f0      equ     $4068
divl_f2_f2      equ     $406a
divl_f2_f4      equ     $406c
divl_f2_f6      equ     $406e
divl_f4_f0      equ     $4070
divl_f4_f2      equ     $4072
divl_f4_f4      equ     $4074
divl_f4_f6      equ     $4076
divl_f6_f0      equ     $4078
divl_f6_f2      equ     $407a
divl_f6_f4      equ     $407c
divl_f6_f6      equ     $407e
negl_f0_f0      equ     $4080
negl_f0_f2      equ     $4082
negl_f0_f4      equ     $4084
negl_f0_f6      equ     $4086
negl_f2_f0      equ     $4088
negl_f2_f2      equ     $408a
negl_f2_f4      equ     $408c
negl_f2_f6      equ     $408e
negl_f4_f0      equ     $4090
negl_f4_f2      equ     $4092
negl_f4_f4      equ     $4094
negl_f4_f6      equ     $4096
negl_f6_f0      equ     $4098
negl_f6_f2      equ     $409a
negl_f6_f4      equ     $409c
negl_f6_f6      equ     $409e
absl_f0_f0      equ     $40a0
absl_f0_f2      equ     $40a2
absl_f0_f4      equ     $40a4
absl_f0_f6      equ     $40a6
absl_f2_f0      equ     $40a8
absl_f2_f2      equ     $40aa
absl_f2_f4      equ     $40ac
absl_f2_f6      equ     $40ae
absl_f4_f0      equ     $40b0
absl_f4_f2      equ     $40b2
absl_f4_f4      equ     $40b4
absl_f4_f6      equ     $40b6
absl_f6_f0      equ     $40b8
absl_f6_f2      equ     $40ba
absl_f6_f4      equ     $40bc
absl_f6_f6      equ     $40be
addf_f0_f0      equ     $40c0
addf_f0_f1      equ     $40c2
addf_f0_f2      equ     $40c4
addf_f0_f3      equ     $40c6
addf_f0_f4      equ     $40c8
addf_f0_f5      equ     $40ca
addf_f0_f6      equ     $40cc
addf_f0_f7      equ     $40ce
addf_f1_f0      equ     $40d0
addf_f1_f1      equ     $40d2
addf_f1_f2      equ     $40d4
addf_f1_f3      equ     $40d6
addf_f1_f4      equ     $40d8
addf_f1_f5      equ     $40da
addf_f1_f6      equ     $40dc
addf_f1_f7      equ     $40de
addf_f2_f0      equ     $40e0
addf_f2_f1      equ     $40e2
addf_f2_f2      equ     $40e4
addf_f2_f3      equ     $40e6
addf_f2_f4      equ     $40e8
addf_f2_f5      equ     $40ea
addf_f2_f6      equ     $40ec
addf_f2_f7      equ     $40ee
addf_f3_f0      equ     $40f0
addf_f3_f1      equ     $40f2
addf_f3_f2      equ     $40f4
addf_f3_f3      equ     $40f6
addf_f3_f4      equ     $40f8
addf_f3_f5      equ     $40fa
addf_f3_f6      equ     $40fc
addf_f3_f7      equ     $40fe
addf_f4_f0      equ     $4100
addf_f4_f1      equ     $4102
addf_f4_f2      equ     $4104
addf_f4_f3      equ     $4106
addf_f4_f4      equ     $4108
addf_f4_f5      equ     $410a
addf_f4_f6      equ     $410c
addf_f4_f7      equ     $410e
addf_f5_f0      equ     $4110
addf_f5_f1      equ     $4112
addf_f5_f2      equ     $4114
addf_f5_f3      equ     $4116
addf_f5_f4      equ     $4118
addf_f5_f5      equ     $411a
addf_f5_f6      equ     $411c
addf_f5_f7      equ     $411e
addf_f6_f0      equ     $4120
addf_f6_f1      equ     $4122
addf_f6_f2      equ     $4124
addf_f6_f3      equ     $4126
addf_f6_f4      equ     $4128
addf_f6_f5      equ     $412a
addf_f6_f6      equ     $412c
addf_f6_f7      equ     $412e
addf_f7_f0      equ     $4130
addf_f7_f1      equ     $4132
addf_f7_f2      equ     $4134
addf_f7_f3      equ     $4136
addf_f7_f4      equ     $4138
addf_f7_f5      equ     $413a
addf_f7_f6      equ     $413c
addf_f7_f7      equ     $413e
subf_f0_f0      equ     $4140
subf_f0_f1      equ     $4142
subf_f0_f2      equ     $4144
subf_f0_f3      equ     $4146
subf_f0_f4      equ     $4148
subf_f0_f5      equ     $414a
subf_f0_f6      equ     $414c
subf_f0_f7      equ     $414e
subf_f1_f0      equ     $4150
subf_f1_f1      equ     $4152
subf_f1_f2      equ     $4154
subf_f1_f3      equ     $4156
subf_f1_f4      equ     $4158
subf_f1_f5      equ     $415a
subf_f1_f6      equ     $415c
subf_f1_f7      equ     $415e
subf_f2_f0      equ     $4160
subf_f2_f1      equ     $4162
subf_f2_f2      equ     $4164
subf_f2_f3      equ     $4166
subf_f2_f4      equ     $4168
subf_f2_f5      equ     $416a
subf_f2_f6      equ     $416c
subf_f2_f7      equ     $416e
subf_f3_f0      equ     $4170
subf_f3_f1      equ     $4172
subf_f3_f2      equ     $4174
subf_f3_f3      equ     $4176
subf_f3_f4      equ     $4178
subf_f3_f5      equ     $417a
subf_f3_f6      equ     $417c
subf_f3_f7      equ     $417e
subf_f4_f0      equ     $4180
subf_f4_f1      equ     $4182
subf_f4_f2      equ     $4184
subf_f4_f3      equ     $4186
subf_f4_f4      equ     $4188
subf_f4_f5      equ     $418a
subf_f4_f6      equ     $418c
subf_f4_f7      equ     $418e
subf_f5_f0      equ     $4190
subf_f5_f1      equ     $4192
subf_f5_f2      equ     $4194
subf_f5_f3      equ     $4196
subf_f5_f4      equ     $4198
subf_f5_f5      equ     $419a
subf_f5_f6      equ     $419c
subf_f5_f7      equ     $419e
subf_f6_f0      equ     $41a0
subf_f6_f1      equ     $41a2
subf_f6_f2      equ     $41a4
subf_f6_f3      equ     $41a6
subf_f6_f4      equ     $41a8
subf_f6_f5      equ     $41aa
subf_f6_f6      equ     $41ac
subf_f6_f7      equ     $41ae
subf_f7_f0      equ     $41b0
subf_f7_f1      equ     $41b2
subf_f7_f2      equ     $41b4
subf_f7_f3      equ     $41b6
subf_f7_f4      equ     $41b8
subf_f7_f5      equ     $41ba
subf_f7_f6      equ     $41bc
subf_f7_f7      equ     $41be
mulf_f0_f0      equ     $41c0
mulf_f0_f1      equ     $41c2
mulf_f0_f2      equ     $41c4
mulf_f0_f3      equ     $41c6
mulf_f0_f4      equ     $41c8
mulf_f0_f5      equ     $41ca
mulf_f0_f6      equ     $41cc
mulf_f0_f7      equ     $41ce
mulf_f1_f0      equ     $41d0
mulf_f1_f1      equ     $41d2
mulf_f1_f2      equ     $41d4
mulf_f1_f3      equ     $41d6
mulf_f1_f4      equ     $41d8
mulf_f1_f5      equ     $41da
mulf_f1_f6      equ     $41dc
mulf_f1_f7      equ     $41de
mulf_f2_f0      equ     $41e0
mulf_f2_f1      equ     $41e2
mulf_f2_f2      equ     $41e4
mulf_f2_f3      equ     $41e6
mulf_f2_f4      equ     $41e8
mulf_f2_f5      equ     $41ea
mulf_f2_f6      equ     $41ec
mulf_f2_f7      equ     $41ee
mulf_f3_f0      equ     $41f0
mulf_f3_f1      equ     $41f2
mulf_f3_f2      equ     $41f4
mulf_f3_f3      equ     $41f6
mulf_f3_f4      equ     $41f8
mulf_f3_f5      equ     $41fa
mulf_f3_f6      equ     $41fc
mulf_f3_f7      equ     $41fe
mulf_f4_f0      equ     $4200
mulf_f4_f1      equ     $4202
mulf_f4_f2      equ     $4204
mulf_f4_f3      equ     $4206
mulf_f4_f4      equ     $4208
mulf_f4_f5      equ     $420a
mulf_f4_f6      equ     $420c
mulf_f4_f7      equ     $420e
mulf_f5_f0      equ     $4210
mulf_f5_f1      equ     $4212
mulf_f5_f2      equ     $4214
mulf_f5_f3      equ     $4216
mulf_f5_f4      equ     $4218
mulf_f5_f5      equ     $421a
mulf_f5_f6      equ     $421c
mulf_f5_f7      equ     $421e
mulf_f6_f0      equ     $4220
mulf_f6_f1      equ     $4222
mulf_f6_f2      equ     $4224
mulf_f6_f3      equ     $4226
mulf_f6_f4      equ     $4228
mulf_f6_f5      equ     $422a
mulf_f6_f6      equ     $422c
mulf_f6_f7      equ     $422e
mulf_f7_f0      equ     $4230
mulf_f7_f1      equ     $4232
mulf_f7_f2      equ     $4234
mulf_f7_f3      equ     $4236
mulf_f7_f4      equ     $4238
mulf_f7_f5      equ     $423a
mulf_f7_f6      equ     $423c
mulf_f7_f7      equ     $423e
divf_f0_f0      equ     $4240
divf_f0_f1      equ     $4242
divf_f0_f2      equ     $4244
divf_f0_f3      equ     $4246
divf_f0_f4      equ     $4248
divf_f0_f5      equ     $424a
divf_f0_f6      equ     $424c
divf_f0_f7      equ     $424e
divf_f1_f0      equ     $4250
divf_f1_f1      equ     $4252
divf_f1_f2      equ     $4254
divf_f1_f3      equ     $4256
divf_f1_f4      equ     $4258
divf_f1_f5      equ     $425a
divf_f1_f6      equ     $425c
divf_f1_f7      equ     $425e
divf_f2_f0      equ     $4260
divf_f2_f1      equ     $4262
divf_f2_f2      equ     $4264
divf_f2_f3      equ     $4266
divf_f2_f4      equ     $4268
divf_f2_f5      equ     $426a
divf_f2_f6      equ     $426c
divf_f2_f7      equ     $426e
divf_f3_f0      equ     $4270
divf_f3_f1      equ     $4272
divf_f3_f2      equ     $4274
divf_f3_f3      equ     $4276
divf_f3_f4      equ     $4278
divf_f3_f5      equ     $427a
divf_f3_f6      equ     $427c
divf_f3_f7      equ     $427e
divf_f4_f0      equ     $4280
divf_f4_f1      equ     $4282
divf_f4_f2      equ     $4284
divf_f4_f3      equ     $4286
divf_f4_f4      equ     $4288
divf_f4_f5      equ     $428a
divf_f4_f6      equ     $428c
divf_f4_f7      equ     $428e
divf_f5_f0      equ     $4290
divf_f5_f1      equ     $4292
divf_f5_f2      equ     $4294
divf_f5_f3      equ     $4296
divf_f5_f4      equ     $4298
divf_f5_f5      equ     $429a
divf_f5_f6      equ     $429c
divf_f5_f7      equ     $429e
divf_f6_f0      equ     $42a0
divf_f6_f1      equ     $42a2
divf_f6_f2      equ     $42a4
divf_f6_f3      equ     $42a6
divf_f6_f4      equ     $42a8
divf_f6_f5      equ     $42aa
divf_f6_f6      equ     $42ac
divf_f6_f7      equ     $42ae
divf_f7_f0      equ     $42b0
divf_f7_f1      equ     $42b2
divf_f7_f2      equ     $42b4
divf_f7_f3      equ     $42b6
divf_f7_f4      equ     $42b8
divf_f7_f5      equ     $42ba
divf_f7_f6      equ     $42bc
divf_f7_f7      equ     $42be
negf_f0_f0      equ     $42c0
negf_f0_f1      equ     $42c2
negf_f0_f2      equ     $42c4
negf_f0_f3      equ     $42c6
negf_f0_f4      equ     $42c8
negf_f0_f5      equ     $42ca
negf_f0_f6      equ     $42cc
negf_f0_f7      equ     $42ce
negf_f1_f0      equ     $42d0
negf_f1_f1      equ     $42d2
negf_f1_f2      equ     $42d4
negf_f1_f3      equ     $42d6
negf_f1_f4      equ     $42d8
negf_f1_f5      equ     $42da
negf_f1_f6      equ     $42dc
negf_f1_f7      equ     $42de
negf_f2_f0      equ     $42e0
negf_f2_f1      equ     $42e2
negf_f2_f2      equ     $42e4
negf_f2_f3      equ     $42e6
negf_f2_f4      equ     $42e8
negf_f2_f5      equ     $42ea
negf_f2_f6      equ     $42ec
negf_f2_f7      equ     $42ee
negf_f3_f0      equ     $42f0
negf_f3_f1      equ     $42f2
negf_f3_f2      equ     $42f4
negf_f3_f3      equ     $42f6
negf_f3_f4      equ     $42f8
negf_f3_f5      equ     $42fa
negf_f3_f6      equ     $42fc
negf_f3_f7      equ     $42fe
negf_f4_f0      equ     $4300
negf_f4_f1      equ     $4302
negf_f4_f2      equ     $4304
negf_f4_f3      equ     $4306
negf_f4_f4      equ     $4308
negf_f4_f5      equ     $430a
negf_f4_f6      equ     $430c
negf_f4_f7      equ     $430e
negf_f5_f0      equ     $4310
negf_f5_f1      equ     $4312
negf_f5_f2      equ     $4314
negf_f5_f3      equ     $4316
negf_f5_f4      equ     $4318
negf_f5_f5      equ     $431a
negf_f5_f6      equ     $431c
negf_f5_f7      equ     $431e
negf_f6_f0      equ     $4320
negf_f6_f1      equ     $4322
negf_f6_f2      equ     $4324
negf_f6_f3      equ     $4326
negf_f6_f4      equ     $4328
negf_f6_f5      equ     $432a
negf_f6_f6      equ     $432c
negf_f6_f7      equ     $432e
negf_f7_f0      equ     $4330
negf_f7_f1      equ     $4332
negf_f7_f2      equ     $4334
negf_f7_f3      equ     $4336
negf_f7_f4      equ     $4338
negf_f7_f5      equ     $433a
negf_f7_f6      equ     $433c
negf_f7_f7      equ     $433e
absf_f0_f0      equ     $4340
absf_f0_f1      equ     $4342
absf_f0_f2      equ     $4344
absf_f0_f3      equ     $4346
absf_f0_f4      equ     $4348
absf_f0_f5      equ     $434a
absf_f0_f6      equ     $434c
absf_f0_f7      equ     $434e
absf_f1_f0      equ     $4350
absf_f1_f1      equ     $4352
absf_f1_f2      equ     $4354
absf_f1_f3      equ     $4356
absf_f1_f4      equ     $4358
absf_f1_f5      equ     $435a
absf_f1_f6      equ     $435c
absf_f1_f7      equ     $435e
absf_f2_f0      equ     $4360
absf_f2_f1      equ     $4362
absf_f2_f2      equ     $4364
absf_f2_f3      equ     $4366
absf_f2_f4      equ     $4368
absf_f2_f5      equ     $436a
absf_f2_f6      equ     $436c
absf_f2_f7      equ     $436e
absf_f3_f0      equ     $4370
absf_f3_f1      equ     $4372
absf_f3_f2      equ     $4374
absf_f3_f3      equ     $4376
absf_f3_f4      equ     $4378
absf_f3_f5      equ     $437a
absf_f3_f6      equ     $437c
absf_f3_f7      equ     $437e
absf_f4_f0      equ     $4380
absf_f4_f1      equ     $4382
absf_f4_f2      equ     $4384
absf_f4_f3      equ     $4386
absf_f4_f4      equ     $4388
absf_f4_f5      equ     $438a
absf_f4_f6      equ     $438c
absf_f4_f7      equ     $438e
absf_f5_f0      equ     $4390
absf_f5_f1      equ     $4392
absf_f5_f2      equ     $4394
absf_f5_f3      equ     $4396
absf_f5_f4      equ     $4398
absf_f5_f5      equ     $439a
absf_f5_f6      equ     $439c
absf_f5_f7      equ     $439e
absf_f6_f0      equ     $43a0
absf_f6_f1      equ     $43a2
absf_f6_f2      equ     $43a4
absf_f6_f3      equ     $43a6
absf_f6_f4      equ     $43a8
absf_f6_f5      equ     $43aa
absf_f6_f6      equ     $43ac
absf_f6_f7      equ     $43ae
absf_f7_f0      equ     $43b0
absf_f7_f1      equ     $43b2
absf_f7_f2      equ     $43b4
absf_f7_f3      equ     $43b6
absf_f7_f4      equ     $43b8
absf_f7_f5      equ     $43ba
absf_f7_f6      equ     $43bc
absf_f7_f7      equ     $43be
movfl_f0_f0     equ     $43c0
movfl_f0_f2     equ     $43c2
movfl_f0_f4     equ     $43c4
movfl_f0_f6     equ     $43c6
movfl_f1_f0     equ     $43c8
movfl_f1_f2     equ     $43ca
movfl_f1_f4     equ     $43cc
movfl_f1_f6     equ     $43ce
movfl_f2_f0     equ     $43d0
movfl_f2_f2     equ     $43d2
movfl_f2_f4     equ     $43d4
movfl_f2_f6     equ     $43d6
movfl_f3_f0     equ     $43d8
movfl_f3_f2     equ     $43da
movfl_f3_f4     equ     $43dc
movfl_f3_f6     equ     $43de
movfl_f4_f0     equ     $43e0
movfl_f4_f2     equ     $43e2
movfl_f4_f4     equ     $43e4
movfl_f4_f6     equ     $43e6
movfl_f5_f0     equ     $43e8
movfl_f5_f2     equ     $43ea
movfl_f5_f4     equ     $43ec
movfl_f5_f6     equ     $43ee
movfl_f6_f0     equ     $43f0
movfl_f6_f2     equ     $43f2
movfl_f6_f4     equ     $43f4
movfl_f6_f6     equ     $43f6
movfl_f7_f0     equ     $43f8
movfl_f7_f2     equ     $43fa
movfl_f7_f4     equ     $43fc
movfl_f7_f6     equ     $43fe
movlf_f0_f0     equ     $4400
movlf_f0_f1     equ     $4402
movlf_f0_f2     equ     $4404
movlf_f0_f3     equ     $4406
movlf_f0_f4     equ     $4408
movlf_f0_f5     equ     $440a
movlf_f0_f6     equ     $440c
movlf_f0_f7     equ     $440e
movlf_f2_f0     equ     $4410
movlf_f2_f1     equ     $4412
movlf_f2_f2     equ     $4414
movlf_f2_f3     equ     $4416
movlf_f2_f4     equ     $4418
movlf_f2_f5     equ     $441a
movlf_f2_f6     equ     $441c
movlf_f2_f7     equ     $441e
movlf_f4_f0     equ     $4420
movlf_f4_f1     equ     $4422
movlf_f4_f2     equ     $4424
movlf_f4_f3     equ     $4426
movlf_f4_f4     equ     $4428
movlf_f4_f5     equ     $442a
movlf_f4_f6     equ     $442c
movlf_f4_f7     equ     $442e
movlf_f6_f0     equ     $4430
movlf_f6_f1     equ     $4432
movlf_f6_f2     equ     $4434
movlf_f6_f3     equ     $4436
movlf_f6_f4     equ     $4438
movlf_f6_f5     equ     $443a
movlf_f6_f6     equ     $443c
movlf_f6_f7     equ     $443e
movl_f0_f0      equ     $4440
movl_f0_f2      equ     $4442
movl_f0_f4      equ     $4444
movl_f0_f6      equ     $4446
movl_f2_f0      equ     $4448
movl_f2_f2      equ     $444a
movl_f2_f4      equ     $444c
movl_f2_f6      equ     $444e
movl_f4_f0      equ     $4450
movl_f4_f2      equ     $4452
movl_f4_f4      equ     $4454
movl_f4_f6      equ     $4456
movl_f6_f0      equ     $4458
movl_f6_f2      equ     $445a
movl_f6_f4      equ     $445c
movl_f6_f6      equ     $445e
movf_f0_f0      equ     $4460
movf_f0_f1      equ     $4462
movf_f0_f2      equ     $4464
movf_f0_f3      equ     $4466
movf_f0_f4      equ     $4468
movf_f0_f5      equ     $446a
movf_f0_f6      equ     $446c
movf_f0_f7      equ     $446e
movf_f1_f0      equ     $4470
movf_f1_f1      equ     $4472
movf_f1_f2      equ     $4474
movf_f1_f3      equ     $4476
movf_f1_f4      equ     $4478
movf_f1_f5      equ     $447a
movf_f1_f6      equ     $447c
movf_f1_f7      equ     $447e
movf_f2_f0      equ     $4480
movf_f2_f1      equ     $4482
movf_f2_f2      equ     $4484
movf_f2_f3      equ     $4486
movf_f2_f4      equ     $4488
movf_f2_f5      equ     $448a
movf_f2_f6      equ     $448c
movf_f2_f7      equ     $448e
movf_f3_f0      equ     $4490
movf_f3_f1      equ     $4492
movf_f3_f2      equ     $4494
movf_f3_f3      equ     $4496
movf_f3_f4      equ     $4498
movf_f3_f5      equ     $449a
movf_f3_f6      equ     $449c
movf_f3_f7      equ     $449e
movf_f4_f0      equ     $44a0
movf_f4_f1      equ     $44a2
movf_f4_f2      equ     $44a4
movf_f4_f3      equ     $44a6
movf_f4_f4      equ     $44a8
movf_f4_f5      equ     $44aa
movf_f4_f6      equ     $44ac
movf_f4_f7      equ     $44ae
movf_f5_f0      equ     $44b0
movf_f5_f1      equ     $44b2
movf_f5_f2      equ     $44b4
movf_f5_f3      equ     $44b6
movf_f5_f4      equ     $44b8
movf_f5_f5      equ     $44ba
movf_f5_f6      equ     $44bc
movf_f5_f7      equ     $44be
movf_f6_f0      equ     $44c0
movf_f6_f1      equ     $44c2
movf_f6_f2      equ     $44c4
movf_f6_f3      equ     $44c6
movf_f6_f4      equ     $44c8
movf_f6_f5      equ     $44ca
movf_f6_f6      equ     $44cc
movf_f6_f7      equ     $44ce
movf_f7_f0      equ     $44d0
movf_f7_f1      equ     $44d2
movf_f7_f2      equ     $44d4
movf_f7_f3      equ     $44d6
movf_f7_f4      equ     $44d8
movf_f7_f5      equ     $44da
movf_f7_f6      equ     $44dc
movf_f7_f7      equ     $44de

movf_m_f7       equ     $44e0
movf_m_f6       equ     $44e4
movf_m_f5       equ     $44e8
movf_m_f4       equ     $44ec
movf_m_f3       equ     $44f0
movf_m_f2       equ     $44f4
movf_m_f1       equ     $44f8
movf_m_f0       equ     $44fc
movif_m_f7      equ     $4500
movif_m_f6      equ     $4504
movif_m_f5      equ     $4508
movif_m_f4      equ     $450c
movif_m_f3      equ     $4510
movif_m_f2      equ     $4514
movif_m_f1      equ     $4518
movif_m_f0      equ     $451c
movil_m_f6      equ     $4520
movil_m_f4      equ     $4524
movil_m_f2      equ     $4528
movil_m_f0      equ     $452c
movfl_m_f6      equ     $4530
movfl_m_f4      equ     $4534
movfl_m_f2      equ     $4538
movfl_m_f0      equ     $453c
lfsr_m_m        equ     $4540

movf_f7_m       equ     $4550
movf_f6_m       equ     $4554
movf_f5_m       equ     $4558
movf_f4_m       equ     $455c
movf_f3_m       equ     $4560
movf_f2_m       equ     $4564
movf_f1_m       equ     $4568
movf_f0_m       equ     $456c
movlf_f6_m      equ     $4570
movlf_f4_m      equ     $4574
movlf_f2_m      equ     $4578
movlf_f0_m      equ     $457c
sfsr_m_m        equ     $4580

@EOF

chmod 666 PAWS.SID.Demos/FP_PSEUDO

echo x - PAWS.SID.Demos/GENERAL_5
cat >PAWS.SID.Demos/GENERAL_5 <<'@EOF'
$COPYRIGHT 'COPYRIGHT (C) 1982 BY HEWLETT-PACKARD COMPANY'$
$SYSPROG ON$
$PARTIAL_EVAL ON$
$STACKCHECK ON$
$RANGE OFF$
$DEBUG OFF$
$OVFLCHECK OFF$
(************************************************************************)
(*                                                                      *)
(*      not released    VERSION         2.0                             *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      IOLIB           extensions                                      *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      library      -  IOLIB                                           *)
(*      name         -  EXTLIB                                          *)
(*      module(s)    -  general_5                                       *)
(*                                                                      *)
(*                                                                      *)
(*      date         -  July 22 , 1982                                  *)
(*      update       -  July 30 , 1982                                  *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)

(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      GENERAL EXTENSIONS                                              *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)



MODULE general_5 ;     

        { date    07/22/82
          update  07/23/82
          update  10/03/83 to version on p 500 of SDG (07/30/82 version)
          
          purpose This module contains the LEVEL 5 GENERAL GROUP procedures.   
        }


IMPORT  iodeclarations  ;  

EXPORT 
  
  TYPE user_eot_proc = PROCEDURE ( parameter : INTEGER );
  
  PROCEDURE on_eot     ( VAR b_info: buf_info_type ;
                         your_proc : user_eot_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_eot    ( VAR b_info: buf_info_type  );
  
IMPLEMENT
  
  PROCEDURE on_eot     ( VAR b_info: buf_info_type ;
                         your_proc : user_eot_proc ;
                         your_parm : INTEGER );
  TYPE proc_coerce   = RECORD CASE BOOLEAN OF 
                         TRUE:  ( user: PROCEDURE ( parm : INTEGER ) );
                         FALSE: ( sys : PROCEDURE ( parm : ANYPTR )  )
                       END;
  TYPE parm_coerce   = RECORD CASE BOOLEAN OF 
                         TRUE:  ( int : INTEGER );
                         FALSE: ( ptr : ANYPTR  )
                       END;
  VAR localproc : proc_coerce;
      localparm : parm_coerce;
  BEGIN
    WITH b_info DO 
      BEGIN
        localproc.user     := your_proc;
        eot_proc.real_proc := localproc.sys;
        localparm.int      := your_parm;
        eot_parm           := localparm.ptr;
      END; { of WITH DO }
  END; { of on_eot }
  
  PROCEDURE off_eot    ( VAR b_info: buf_info_type );
  BEGIN
    WITH b_info DO 
      BEGIN
        eot_proc.dummy_sl := NIL;
        eot_proc.dummy_pr := NIL;
        eot_parm          := NIL; 
      END; { of WITH DO }
  END; { of on_eot }

        
END.    { of general_5 }  

@EOF

chmod 666 PAWS.SID.Demos/GENERAL_5

echo x - PAWS.SID.Demos/GPIO5TEST
cat >PAWS.SID.Demos/GPIO5TEST <<'@EOF'
$SYSPROG$

PROGRAM isrtest(INPUT,OUTPUT);

$SEARCH 'GPIO5'$      {Or wherever it's hidden}

IMPORT iodeclarations, general_0, general_1, gpio_5;

VAR i, count, dummy: INTEGER;

PROCEDURE myproc(temp: INTEGER);
BEGIN
  writeln('           ISR');
  TRY
    i := ioread_word(12,4);      {The SDG specifies sc 15 -- we use 12}
    writeln('               ',i:6);
    count := count-1;
    if count > 0 then
     iowrite_byte(12,0,0)       {start next handshake}
    else
     off_flag(12);              {finished, so turn off interrupt}
  RECOVER
   writeln('             ISR ESCAPE!');
END; {PROCEDURE myproc}

BEGIN
  i     := -1;                  {set i to known value}
  count := 10;                  {input 10 data words from GPIO card}
  set_timeout(12,1.0);
  dummy := ioread_word(12,4);    {set I/O direction to "input"}
  iowrite_byte(12,0,0);         {start first handshake with peripheral}
  on_flag(12,myproc,0);
  WHILE count > 0 DO
   WRITELN('Waiting....',i:6)
END.
@EOF

chmod 666 PAWS.SID.Demos/GPIO5TEST

echo x - PAWS.SID.Demos/GPIO_5
cat >PAWS.SID.Demos/GPIO_5 <<'@EOF'
$COPYRIGHT 'COPYRIGHT (C) 1982 BY HEWLETT-PACKARD COMPANY'$
$SYSPROG ON$
$PARTIAL_EVAL ON$
$STACKCHECK ON$
$RANGE OFF$
$OVFLCHECK OFF$
(************************************************************************)
(*                                                                      *)
(*      not released    VERSION         2.0                             *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      IOLIB           extensions                                      *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      library      -  IOLIB                                           *)
(*      name         -  EXTLIB                                          *)
(*      module(s)    -  gpio_5                                          *)
(*                                                                      *)
(*      date         -  July 22 , 1982                                  *)
(*      update       -  July 30 , 1982                                  *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)

(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      GENERAL EXTENSIONS                                              *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)

PROGRAM gpio_5_init(OUTPUT);


MODULE gpio_5 ;     

        { date    07/26/82
          update  07/30/82
          
          purpose This module contains the LEVEL 5 GPIO GROUP procedures.   
        }


IMPORT  iodeclarations , iocomasm , general_0 ;

EXPORT 
  
  TYPE  gpio_user_proc = PROCEDURE ( parameter : INTEGER );
  
  TYPE  gpio_isr_block = RECORD
                           state : PACKED ARRAY[0..0] OF BOOLEAN;
                           mask  : INTEGER;
                           procs : ARRAY[0..0] OF gpio_user_proc;
                           parms : ARRAY[0..0] OF INTEGER;
                         END;
  
  VAR   gpio_isr_table : ARRAY[iominisc..iomaxisc] OF ^gpio_isr_block;
  
  PROCEDURE on_flag    ( isc       : type_isc  ;
                         your_proc : gpio_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_flag   ( isc       : type_isc );
  
  
IMPLEMENT
  
  CONST flgcond        = 0;     flgmask = 128;
  
  TYPE coerce = RECORD CASE BOOLEAN OF
                  TRUE:  ( int : INTEGER );
                  FALSE: ( ptr : ANYPTR )
                END;
  
  PROCEDURE gpio_isr_allocate
                       ( isc       : type_isc );
  VAR counter : INTEGER;
  BEGIN
    NEW(gpio_isr_table[isc] );
    WITH gpio_isr_table[isc]^ DO BEGIN
      FOR counter:=flgcond TO flgcond DO state[counter] := FALSE;
      mask := 0;      
    END; { of WITH DO BEGIN }
  END; { of gpio_isr_allocate }
  
  PROCEDURE gpio_isr_proc
                       ( temp      : ANYPTR );
  VAR counter : INTEGER;
      happened: BOOLEAN;
      isc     : INTEGER;
      local   : coerce ;
  BEGIN
    local.ptr := temp;
    isc       := local.int;
    
    { prevent gpio_isr_proc in user_isr in temps }
    iocontrol( isc , 5 , 0 );
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
      user_isr.dummy_sl := NIL;
      user_isr.dummy_pr := NIL;
    END; { of WITH isc_table DO BEGIN }
      
    WITH gpio_isr_table[isc]^ DO BEGIN
      FOR counter := flgcond TO flgcond DO 
        IF state[ counter ] 
          THEN BEGIN
            happened := FALSE;
            CASE counter OF
              flgcond: happened:=bit_set(ioread_byte(isc,0),0);
            END; { of CASE }
            IF happened THEN CALL( procs[counter] , parms[counter] );
          END; { of FOR DO IF bit_set THEN }
      
    { set up gpio_isr_proc in user_isr in temps }
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
      user_isr.real_proc := gpio_isr_proc;
    END; { of WITH DO BEGIN }
    
    { re - enable interrupts }
    iocontrol( isc , 5 , mask );
  
  END; { of WITH BEGIN }
END; { of gpio_isr_proc }
  
  PROCEDURE gpio_isr_setup
                       ( isc       : type_isc ;
                         your_proc : gpio_user_proc ;
                         your_parm : INTEGER ;
                         which_cond: INTEGER );
  VAR local : coerce ;
  BEGIN
    IF ( isc_table[isc].card_id <> hp98622 ) THEN io_escape(ioe_misc,isc);
    IF gpio_isr_table[isc] = NIL THEN gpio_isr_allocate(isc);
    WITH gpio_isr_table[isc]^ DO BEGIN
      { set up procedures & parameters in allocated isr proc block }
      procs[which_cond] := your_proc;
      parms[which_cond] := your_parm;
    
      { set up state condition and interrupt mask }
      CASE which_cond OF
        flgcond:  mask:=BINIOR(mask,flgmask);
      END; { of CASE }
      state[which_cond] := TRUE;
      
      { set up gpio_isr_proc in user_isr in temps }
      WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
        user_isr.real_proc := gpio_isr_proc;
        local.int          := isc;              { type coercion }
        user_parm          := local.ptr;        { type coercion }
      END; { of WITH DO BEGIN }
      
      { enable card }
      iocontrol( isc , 5 , mask );
    END; { of WITH DO BEGIN }
  END; { of gpio_isr_setup }
  
  PROCEDURE gpio_isr_kill
                       ( isc       : type_isc ;
                         which_cond: INTEGER );
  BEGIN
    IF gpio_isr_table[isc] <> NIL THEN 
    WITH gpio_isr_table[isc]^ DO BEGIN
    
      { clear state condition and interrupt mask }
      CASE which_cond OF
        flgcond:  mask:=BINAND(mask,BINCMP(flgmask));
      END; { of CASE }
      state[which_cond] := FALSE;
      
      { if necessary clear gpio_isr_proc in user_isr in temps }
      IF mask=0 THEN WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
        user_isr.dummy_sl := NIL;
        user_isr.dummy_pr := NIL;
        user_parm         := NIL;
      END; { of WITH isc_table DO BEGIN }
      
      { disable or enable card as specified by the mask  }
      iocontrol( isc , 5 , mask );
    END; { of WITH DO BEGIN }
  END; { of gpio_isr_kill }
  
  
  PROCEDURE on_flag    ( isc       : type_isc  ;
                         your_proc : gpio_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    gpio_isr_setup(isc,your_proc,your_parm,flgcond );
  END;
  
  PROCEDURE off_flag   ( isc       : type_isc );
  BEGIN
    gpio_isr_kill(isc,flgcond );
  END;
  
END; { of gpio_5 }


IMPORT iodeclarations , gpio_5;
VAR counter : INTEGER;
BEGIN
  FOR counter := iominisc TO iomaxisc DO 
    gpio_isr_table[counter] := NIL;
END.    { of gpio_5_init  }  

@EOF

chmod 666 PAWS.SID.Demos/GPIO_5

echo x - PAWS.SID.Demos/HPIB5TEST
cat >PAWS.SID.Demos/HPIB5TEST <<'@EOF'
$SYSPROG ON$
PROGRAM isrtest(INPUT,OUTPUT);
$SEARCH '#3:HPIB5'$             { or wherever }
IMPORT iodeclarations,general_1,hpib_0,hpib_2,hpib_3,hpib_5;

VAR i   : INTEGER;

PROCEDURE myproc(temp : INTEGER);
BEGIN
  WRITELN('                     ISR ');
  TRY
    i:=spoll(730);
    WRITELN('                     ',i:4);
    clear_hpib(7,atn_line);     { so 98034 can re-assert srq line  
                                  since I used a 9835/98034 as a 
                                  device }
  RECOVER BEGIN
            WRITELN('             ISR ESCAPE');
            ioreset(7);
          END; 
END;

BEGIN
  i:=-1;
  set_timeout(7,1.0);
  on_srq(7,myproc,0);
  WHILE TRUE DO BEGIN
    WRITELN('waiting ',i:4);
  END;
END.
@EOF

chmod 666 PAWS.SID.Demos/HPIB5TEST

echo x - PAWS.SID.Demos/HPIB_5
cat >PAWS.SID.Demos/HPIB_5 <<'@EOF'
$COPYRIGHT 'COPYRIGHT (C) 1982 BY HEWLETT-PACKARD COMPANY'$
$SYSPROG ON$
$PARTIAL_EVAL ON$
$STACKCHECK ON$
$RANGE OFF$
$DEBUG OFF$
$OVFLCHECK OFF$
(************************************************************************)
(*                                                                      *)
(*      not released    VERSION         2.0                             *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      IOLIB           extensions                                      *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      library      -  IOLIB                                           *)
(*      name         -  EXTLIB                                          *)
(*      module(s)    -  hpib_5                                          *)
(*                                                                      *)
(*      date         -  July 22 , 1982                                  *)
(*      update       -  July 30 , 1982                                  *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)

(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      GENERAL EXTENSIONS                                              *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)

PROGRAM hpib_5_init;


MODULE hpib_5 ;     

        { date    07/22/82
          update  07/30/82
          
          purpose This module contains the LEVEL 5 HPIB GROUP procedures.   
        }


IMPORT  iodeclarations , iocomasm , general_0 , hpib_1 , hpib_3  ;  

EXPORT 
  
  TYPE  hpib_user_proc = PROCEDURE ( parameter : INTEGER );
  TYPE  hpib_isr_block = RECORD
                           state : PACKED ARRAY[0..3] OF BOOLEAN;
                           mask  : INTEGER;
                           procs : ARRAY[0..3] OF hpib_user_proc;
                           parms : ARRAY[0..3] OF INTEGER;
                         END;
  
  VAR   hpib_isr_table : ARRAY[iominisc..iomaxisc] OF ^hpib_isr_block;
  
  PROCEDURE on_srq     ( isc       : type_isc  ;
                         your_proc : hpib_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_srq    ( isc       : type_isc );
  
  PROCEDURE on_talker  ( isc       : type_isc  ;
                         your_proc : hpib_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_talker ( isc       : type_isc );
  
  PROCEDURE on_listener( isc       : type_isc  ;
                         your_proc : hpib_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_listener(isc       : type_isc );
  
  PROCEDURE on_active_ctl
                       ( isc       : type_isc  ;
                         your_proc : hpib_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_active_ctl
                       ( isc       : type_isc );
  
IMPLEMENT
  
  CONST srqcond        = 0;     srqmask = 128;
        tlkcond        = 1;     tlkmask =  32;
        lstcond        = 2;     lstmask =  16;
        ctlcond        = 3;     ctlmask =  64;
  
  TYPE  coerce = RECORD CASE BOOLEAN OF
                   TRUE:  ( int : INTEGER );
                   FALSE: ( ptr : ANYPTR )
                 END;
        
  
  PROCEDURE hpib_isr_allocate
                       ( isc       : type_isc );
  VAR counter : INTEGER;
  BEGIN
    NEW(hpib_isr_table[isc] );
    WITH hpib_isr_table[isc]^ DO BEGIN
      FOR counter:=srqcond TO ctlcond DO state[counter] := FALSE;
      mask := 0;      
    END; { of WITH DO BEGIN }
  END; { of hpib_isr_allocate }
  
  PROCEDURE hpib_isr_proc
                       ( temp      : ANYPTR  );
  VAR counter : INTEGER;
      happened: BOOLEAN;
      isc     : INTEGER;
      local   : coerce ;
  BEGIN
    local.ptr := temp;                  { coerce for select code }
    isc       := local.int;
    
    { prevent hpib_isr_proc in user_isr in temps }
    iocontrol( isc , 5 , 0 );
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
      user_isr.dummy_sl := NIL;
      user_isr.dummy_pr := NIL;
    END; { of WITH isc_table DO BEGIN }
      
    WITH hpib_isr_table[isc]^ DO BEGIN
      FOR counter := srqcond TO ctlcond DO 
        IF state[ counter ] 
          THEN BEGIN
            happened := FALSE;
            CASE counter OF
              srqcond: happened:=requested(isc);
              tlkcond: happened:=talker(isc);
              lstcond: happened:=listener(isc);
              ctlcond: happened:=active_controller(isc);
            END; { of CASE }
            IF happened THEN CALL( procs[counter] , parms[counter] );
          END; { of FOR DO IF bit_set THEN }
      
    { set up hpib_isr_proc in user_isr in temps }
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
      user_isr.real_proc := hpib_isr_proc;
    END; { of WITH DO BEGIN }
    
    { re - enable interrupts }
    iocontrol( isc , 5 , mask );
  
  END; { of WITH BEGIN }
END; { of hpib_isr_proc }
  
  PROCEDURE hpib_isr_setup
                       ( isc       : type_isc ;
                         your_proc : hpib_user_proc ;
                         your_parm : INTEGER ;
                         which_cond: INTEGER );
  VAR local : coerce;
  BEGIN
    IF ( isc_table[isc].card_id <> hp98624 ) AND
       ( isc_table[isc].card_id <> internal_hpib )
      THEN io_escape(ioe_not_hpib,isc);
    IF hpib_isr_table[isc] = NIL THEN hpib_isr_allocate(isc);
    WITH hpib_isr_table[isc]^ DO BEGIN
      { set up procedures & parameters in allocated isr proc block }
      procs[which_cond] := your_proc;
      parms[which_cond] := your_parm;
    
      { set up state condition and interrupt mask }
      CASE which_cond OF
        srqcond:  mask:=BINIOR(mask,srqmask);
        tlkcond:  mask:=BINIOR(mask,tlkmask);
        lstcond:  mask:=BINIOR(mask,lstmask);
        ctlcond:  mask:=BINIOR(mask,ctlmask);
      END; { of CASE }
      state[which_cond] := TRUE;
      
      { set up hpib_isr_proc in user_isr in temps }
      WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
        user_isr.real_proc := hpib_isr_proc;
        local.int          := isc;              { type coercion }
        user_parm          := local.ptr;        { type coercion }
      END; { of WITH DO BEGIN }
      
      { enable card }
      iocontrol( isc , 5 , mask );
    END; { of WITH DO BEGIN }
  END; { of hpib_isr_setup }
  
  PROCEDURE hpib_isr_kill
                       ( isc       : type_isc ;
                         which_cond: INTEGER );
  BEGIN
    IF hpib_isr_table[isc] <> NIL THEN 
    WITH hpib_isr_table[isc]^ DO BEGIN
    
      { clear state condition and interrupt mask }
      CASE which_cond OF
        srqcond:  mask:=BINAND(mask,BINCMP(srqmask));
        tlkcond:  mask:=BINAND(mask,BINCMP(tlkmask));
        lstcond:  mask:=BINAND(mask,BINCMP(lstmask));
        ctlcond:  mask:=BINAND(mask,BINCMP(ctlmask));
      END; { of CASE }
      state[which_cond] := FALSE;
      
      { if necessary clear hpib_isr_proc in user_isr in temps }
      IF mask=0 THEN WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
        user_isr.dummy_sl := NIL;
        user_isr.dummy_pr := NIL;
        user_parm         := NIL;
      END; { of WITH isc_table DO BEGIN }
      
      { disable or enable card as specified by the mask  }
      iocontrol( isc , 5 , mask );
    END; { of WITH DO BEGIN }
  END; { of hpib_isr_kill }
  
  
  PROCEDURE on_srq     ( isc       : type_isc  ;
                         your_proc : hpib_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    hpib_isr_setup(isc,your_proc,your_parm,srqcond );
  END;
  
  PROCEDURE off_srq    ( isc       : type_isc );
  BEGIN
    hpib_isr_kill(isc,srqcond );
  END;
  
  PROCEDURE on_talker  ( isc       : type_isc  ;
                         your_proc : hpib_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    hpib_isr_setup(isc,your_proc,your_parm,tlkcond);
  END;
  
  PROCEDURE off_talker ( isc       : type_isc );
  BEGIN
    hpib_isr_kill(isc,tlkcond );
  END;
  
  PROCEDURE on_listener( isc       : type_isc  ;
                         your_proc : hpib_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    hpib_isr_setup(isc,your_proc,your_parm,lstcond );
  END;
  
  PROCEDURE off_listener(isc       : type_isc );
  BEGIN
    hpib_isr_kill(isc,lstcond );
  END;
  
  PROCEDURE on_active_ctl
                       ( isc       : type_isc  ;
                         your_proc : hpib_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    hpib_isr_setup(isc,your_proc,your_parm,ctlcond );
  END;
  
  PROCEDURE off_active_ctl
                       ( isc       : type_isc );
  BEGIN
    hpib_isr_kill(isc,ctlcond );
  END;
        
END; { of hpib_5 }


IMPORT iodeclarations , hpib_5;
VAR counter : INTEGER;
BEGIN
  FOR counter := iominisc TO iomaxisc DO 
    hpib_isr_table[counter] := NIL;
END.    { of hpib_5_init  }  

@EOF

chmod 666 PAWS.SID.Demos/HPIB_5

echo x - PAWS.SID.Demos/MOD_DVRS
cat >PAWS.SID.Demos/MOD_DVRS <<'@EOF'
$SYSPROG ON$
PROGRAM modifydrivers(INPUT,OUTPUT);
IMPORT  iodeclarations,general_1,general_2;
VAR     newkbd : drv_table_type;
        oldkbd : ^drv_table_type;
        i      : INTEGER;
  
  { new driver procedure }
  PROCEDURE MYPROC(mytemp : ANYPTR ;
                    mychar : CHAR);  
  BEGIN
    WRITELN('write byte of character value ',ORD(mychar):3,
            ' is <',mychar,'>');
  END;

BEGIN 
  { set up new drivers }
  newkbd := isc_table[1].io_drv_ptr^;      { to copy some drivers }
  oldkbd := ADDR(isc_table[1].io_drv_ptr^);{ to keep the old ones }
  newkbd.iod_wtb := MYPROC;                { add new procedures   }
  isc_table[1].io_drv_ptr := ADDR(newkbd); { set up isc table [1] }
  
  
  { use new drivers }
  writenumberln(1,12.345);
  
  { remove new drivers }
  isc_table[1].io_drv_ptr := ADDR(oldkbd^);
                                           { restore isc table [1] }
END.
@EOF

chmod 666 PAWS.SID.Demos/MOD_DVRS

echo x - PAWS.SID.Demos/NOECHO1
cat >PAWS.SID.Demos/NOECHO1 <<'@EOF'
program ReadNoEcho1(keyboard, output);
var
  Character:            char;
  keyboard:             text;
begin
repeat
  read(keyboard, Character);
  write(output,'You pressed ');
  if Character>=chr(32) then                             {printable character}
    write(output,'"',Character,'", which is ');
  writeln(output,'CHR(',ord(Character):1,').');
until false;                                 {press [STOP] to end the program}
end.
@EOF

chmod 666 PAWS.SID.Demos/NOECHO1

echo x - PAWS.SID.Demos/NOECHO2
cat >PAWS.SID.Demos/NOECHO2 <<'@EOF'
program ReadNoEcho2(output);
var
  Character:            char;
  MyFile:               text;
begin
reset(MyFile,'#2:');                                {open to logical unit two}
repeat
  read(MyFile, Character);
  write(output,'You pressed ');
  if Character>=chr(32) then                             {printable character}
    write(output,'"',Character,'", which is ');
  writeln(output,'CHR(',ord(Character):1,').');
until false;                                 {press [STOP] to end the program}
end.
@EOF

chmod 666 PAWS.SID.Demos/NOECHO2

echo x - PAWS.SID.Demos/PLOTTOMEM
cat >PAWS.SID.Demos/PLOTTOMEM <<'@EOF'
$sysprog, ucsd$

PROGRAM DUMP_LARGE_GRAPHICS ( INPUT,OUTPUT,LISTING);


import dgl_types,
       dgl_lib,
       dgl_vars,
       dgl_gen,
       gle_types,
       gle_gen,
       gle_ras_out,
       sysglobals,
       asm;

type
  graphics_screen = packed array [1..maxint] of char;

var
  graphics_base ['GRAPHICSBASE'] : anyptr;
  gscreen : ^graphics_screen;
  error_return : integer;
  gscreen_width : integer;
  gscreen_height : integer;
  justify_bytes  : integer;
  marked_screen : anyptr;
  old_graphics_base : ^gle_shortint;
  old_gle_gcb : ^graphics_control_block;
  old_gcb     : ^graphics_control_block1;
  old_raster_gcb,
  tmp_raster_gcb: raster_device_rec_ptr;
  
function make_anyptr( p : anyptr ) : anyptr;
{    This function converts a pointer of any type into an ANYPTR.  It is     }
{  for assigning values to variables of type ANYPTR.                         }

begin
  make_anyptr := p;
end;

procedure memory_clear(agcb : graphics_control_block_ptr);
{    This is a screen-clear routine which knows how to clear the simulated   }
{  "screen" in mainframe RAM.  The routine is needed because when you first  }
{  do DISPLAY_INIT in the program, a screen clear for your physical display  }
{  is attached to the GLE_GCB hook for "clear".   For some configurations,   }
{  this routine would also serve to clear the simulated screen, but for      }
{  other than Model 236A-equivalent displays, the procedure installed at     }
{  "clear" may not clear the simulated screen properly.                      }

var
 i,j  : gle_shortint;
 row  : integer;
begin
 for i := 0 to gscreen_height-1 do
  begin
   row := i * gscreen_width;
   for j:= 1 to gscreen_width do
    gscreen^[row + j] := #0;
  end;
end;

procedure take_graphics ( screen_width_dots, screen_height_dots,
                          justify_dots : integer);
{    This procedure puts the currently active display temporarily on hold,   }
{  allocates enough memory to simulate a frame buffer of the size specified  }
{  by SCREEN_WIDTH_DOTS and SCREEN_HEIGHT_DOTS, and redirects plotting       }
{  operations to that memory.                                                }

var
  index : integer;
  raster_gcb : raster_device_rec_ptr;
  
begin
  
  mark(marked_screen);   
  
  { save screen size information in global variables }
  gscreen_width := screen_width_dots div 8;   
  gscreen_height := screen_height_dots;
  justify_bytes := justify_dots div 8;
  
  { redirect graphics library variables to point to new memory, }
  { save old values                                             }
  
  { allocate memory for screen image }
  newwords(gscreen,(gscreen_height*gscreen_width) div 2 + 1);
  
  new(old_gle_gcb);
  old_gle_gcb^ := gle_gcb^;
  
  new(old_gcb);
  old_gcb^ := gcb^;
  
  new(old_raster_gcb);
  tmp_raster_gcb := gle_gcb^.dev_dep_stuff;
  old_raster_gcb^ := tmp_raster_gcb^; 
  
  old_graphics_base := make_anyptr(graphics_base);
  graphics_base := make_anyptr(gscreen);
  
  raster_gcb := gle_gcb^.dev_dep_stuff;
  with gle_gcb^,raster_gcb^ do
    begin
                                      { \  Take over the screen-clearing hook }
      clear := memory_clear;          {  > to ensure that the "screen" in     }
                                      { /  memory can be cleared correctly.   }
      
      display_name := 'MEMORY';       { Plotting device is now memory.        }
      display_name_char_count := 6;   { Number of characters in 'MEMORY'.     }
      
                                      { \   Simulate a display whose          }
      display_res_x := 3.0000;        {  \  resolution is 3 pixels/mm.  This  }
      display_res_y := 3.0000;        {  /  is in the ball park for printers  }
                                      { /   which can dump graphics images.   }
      
      display_min_x := 0;
      display_max_x := ((gscreen_width) * 8 - 1); 
      display_min_y := 0;
      display_max_y := (gscreen_height-1);
      
      color_map_support := 0;  { none }
      
      redef_background := 0;   { no }
      
      pallette     := 1;
      gamut        := 1;
      
      devicetype     := 1;  { simulate 9836A only. Other values are
                  0 = 16/26, 1 = 36, 2 = 98627A, 3 = 36C, 4 = 9837 }
      
      deviceaddress := 0;   { unused }
      
      plane1_addr := addr(graphics_base);
      plane1_offset := 0;
      plane2_offset := 0;
      plane3_offset := 0;
      
      n_glines := display_max_y+1;
      
                               { \   This specifies the spacing (memory-wise) }
                               {  \  of bytes which affect the frame buffer.  }
      gspacing     := 1;       {   > The Models 16 and 26 used only odd bytes }
                               {  /  so the spacing is every two; all others  }
                               { /   use a spacing of one.                    }
  
      bytesperline := gscreen_width;   
  
      hard_xmax := display_max_x;
      hard_ymax := display_max_y;
  
      with gcb^ do
        begin
          max_disp_lim.xmin := display_min_x;
          max_disp_lim.xmax := display_max_x;
          max_disp_lim.ymin := display_min_y;
          max_disp_lim.ymax := display_max_y;
        
          gle_get_p1p2 ( gle_gcb );
      
          def_disp_lim.xmin := info1;
          def_disp_lim.xmax := info2;
          def_disp_lim.ymin := info3;
          def_disp_lim.ymax := info4;
          
          disp_init := true;
          disp_eq_loc :=  ((disp_dev_adr = loc_dev_adr) or
                          ((disp_dev_adr = internal_display) and
                           (loc_dev_adr = internal_locator)));
          
          { set up display limits }
                                    
                                    { \  Is the virtual display coordinate   }
          disp_just := lowerleft;   {  > system centered within the display  }
                                    { /  limits or in the lower left corner? }
          with def_disp_lim do
            display_limits(xmin,xmax,ymin,ymax);
               
          { set up default text size and rotation attributes }
          
          dgl_char_width := init_char_width_factor * 
            abs (window_lim.xmax - window_lim.xmin);
          dgl_char_height := init_char_height_factor * 
            abs (window_lim.ymax - window_lim.ymin);
          set_char_size ( dgl_char_width, dgl_char_height );
          
          char_rot_w := init_char_rot_w;
          char_rot_h := init_char_rot_h;
          
          set_text_rot ( char_rot_w, char_rot_h );
          
          { set up all attributes here        }
          
          dgl_current_polygon_edge := true;
          dgl_current_polygon_crosshatch := false;
          dgl_current_polygon_linestyle := init_linestyle;
          dgl_current_polygon_style := 1;
          dgl_current_polygon_color := init_color;
          dgl_polygon_color_current := false;  { color not set in gle }
          dgl_current_polygon_density := 0;
          dgl_current_polygon_angle := 0;
          set_timing ( dgl_current_timming_mode );
          set_color(init_color);
          set_line_style(init_linestyle);
          set_line_width(init_linewidth);
           
          cpx := init_cpx;      { \   Set the current pen position to the  }
          cpy := init_cpy;      {  >  initial current pen position.  The   }
                                { /   units are device units.              }
          
          marker_size_x := trunc(display_res_x * 2.5 + 0.5); { 2.5 mm in size }
          marker_size_y := marker_size_x;
          info1 := marker_size_x;
          info2 := marker_size_y;
          gle_marker_size ( gle_gcb );
        end;
    end;
    clear_display;
end; { setup_display }

procedure return_graphics;
{    This procedure performs the inverse function of TAKE_GRAPHICS.  It     }
{  redirects plotting operations back to the display and away from the      }
{  pseudo-display in memory.  It also destroys the pseudo-display           }
{  information and releases the pseudo-frame buffer from the heap.          }

var
  error : integer;
  
begin
  graphics_base := make_anyptr(old_graphics_base);
  
  gle_gcb^ := old_gle_gcb^;
  gcb^     := old_gcb^;
  tmp_raster_gcb := gle_gcb^.dev_dep_stuff;
  tmp_raster_gcb^ := old_raster_gcb^;
  
  release(marked_screen);
  
  with gcb^.def_disp_lim do
   display_limits(xmin, xmax, ymin, ymax);
   
end;

procedure dump_graphics;
{    This procedure dumps the graphics image in the memory to a printer which }
{  can do a graphics dump.  The printer must conform to the HP Raster         }
{  Interface Standard in order to work with this procedure.                   }
{    The memory-display must be less than 132 chararacters (1056 pixels)      }
{  wide.                                                                      }

label 1;

var
  gbuffer : string[138 { 132 + 6 }];
  i,j,pindex : integer;
  busy : boolean;
  row : integer;
  cnt : integer;
  
begin
1:
  { escape sequence for graphics }
  gbuffer := '';
  strwrite(gbuffer,1,cnt,chr(27),'*b',gscreen_width:0,'W');
  cnt := cnt - 1;
  setstrlen(gbuffer,gscreen_width+cnt+justify_bytes);
  
  try
    for i := 1 to justify_bytes do
      gbuffer[cnt+i] := chr(0);
      
    for i := 1 to gscreen_height do
      begin
        row := (i - 1) * gscreen_width;
        for j := 1 to gscreen_width do 
          begin
            gbuffer[j+cnt+justify_bytes] := gscreen^[row+j];
          end;
          WRITE(LISTING,GBUFFER:GSCREEN_WIDTH+6);
      end;
  recover ;
  
  gbuffer[1] := chr(27); { terminate graphics sequence }
  gbuffer[2] := '*';
  gbuffer[3] := 'r';
  gbuffer[4] := 'B';
  WRITE(LISTING,GBUFFER:4);
      
end;
procedure pattern(xmin,xmax,ymin,ymax: real);
{    This merely draw a pattern on the display (or pseudo-display) to prove  }
{  that the hooks needed for plotting have been correctly assigned.          }

const
  convert_deg_to_rad = 0.01745329252;
  
var
  dx,dy : real;
  deg   : integer;
  cnt   : integer;
  s : string[20];

begin
  dx := xmax-xmin;
  dy := ymax-ymin;
  set_window(xmin,xmax,ymin,ymax);
  set_aspect(dx,dy);
  move(xmin,ymin);
  line(xmin,ymax);
  line(xmax,ymax);
  line(xmax,ymin);
  line(xmin,ymin);
  set_char_size(dx/25,dy/25);
  deg := 0;
  repeat
    move(dx/2,dy/2);
    set_text_rot(cos(deg*convert_deg_to_rad),sin(deg*convert_deg_to_rad));
    s := '   ---- ';
    strwrite(s,7,cnt,deg:1);
    gtext(s);
    deg := deg + 25;
  until deg > 340;
end;


begin
  graphics_init;
  display_init ( 3,0,error_return);
  if error_return <> 0 then escape(-27);
  pattern(0,1,0,1);
  set_line_style(3);            {set a non-default line style so if something }
                                {goes wrong, it will be obvious.              }
  take_graphics(560,720,0);
  pattern(0,0.5,0,0.5);
{ dump_graphics;                {un-comment this if you have a printer }
                                {which can dump graphics.              }
  return_graphics;
  
  move(0.25,0.25);      {draw a line in line style 3 on the CRT.  If it }
  line(0.75,0.75);      {is not a dashed line, something went wrong.    }
  
  graphics_term;
  
end.
@EOF

chmod 666 PAWS.SID.Demos/PLOTTOMEM

echo x - PAWS.SID.Demos/REMCRT
cat >PAWS.SID.Demos/REMCRT <<'@EOF'
$SYSPROG ON$ 
$heap_dispose off$ 
$iocheck off$ 
$range off$ 
$ovflcheck off$ 
$debug off$
$STACKCHECK OFF$ 

PROGRAM installcrt;

MODULE crt; 

IMPORT sysdevs,sysglobals,asm,misc,iodeclarations,general_0 ; 

EXPORT 
    
  PROCEDURE crtinit; 

IMPLEMENT
 
 
CONST dc1           = 17 ;
      default_isc   = 9;
      
      term_environ=environ[
               miscinfo:crtfrec[
                                nobreak:FALSE,
                                stupid :FALSE,
                                slowterm:FALSE,
                                hasxycrt:TRUE,
                                haslccrt:FALSE,
                                hasclock:TRUE,
                                canupscroll:TRUE,
                                candownscroll:TRUE],
               crttype:0,
               crtctrl:crtcrec[
                                rlf:chr(31),
                                ndfs:chr(28),
                                eraseeol:chr(9),
                                eraseeos:chr(11),
                                home:chr(1),
                                escape:chr(0),
                                backspace:chr(8),
                                fillcount:10,
                                clearscreen:chr(0),
                                clearline:chr(0),
                                prefixed:b9[9 of FALSE]],
               crtinfo:crtirec[ 
                                width :80,height:24,
                                crtmemaddr:0,
                                crtcontroladdr:0,
                                keybufferaddr: 0,
                                progstateinfoaddr: 0,
                                keybuffersize: 0,
                                crtcon: crtconsttype [0,0,0,0,0,0,0,
                                                      0,0,0,0,0],
                                right{FS}:chr(28),
                                left{BS}:chr(8),
                                down{LF}:chr(10),    up{US}:chr(31),
                                badch{?}:chr(63),
                                chardel{BS}:chr(8),stop{DC3} :chr(19), 
                                break{DLE}:chr(16),
                                flush{ACK}:chr(6),  eof{ETX}:chr(3),
                                altmode{ESC}:chr(27), 
                                linedel{DEL}:chr(127),
                                backspace{BS}:chr(8),
                                etx:chr(3),prefix:chr(0),      
                                prefixed:b14[14 of FALSE],
                                cursormask : 0,     spare : 0]];

  
VAR   myisc         : shortint;
      newdrivers    : drv_table_type;
      screenwidth       : shortint;
      screenheight      : shortint;
      maxx,maxy         : shortint;
       
{ note that you should not use the 'console'
  select code for anything else }

PROCEDURE new_reset(mytemp : ANYPTR);
BEGIN
  { do nothing so that the configuration stays the same }
END;

PROCEDURE myinit;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async 
    THEN iocontrol(myisc,28,0);               { no EOL characters }
  iocontrol(myisc,12,1);                      { connect the card  }
  
  newdrivers := isc_table[myisc].io_drv_ptr^; { copy card dvrs    }
  newdrivers.iod_init := new_reset;           { put in new reset  }
  isc_table[myisc].io_drv_ptr := ADDR(newdrivers); { install drvs }
END;

FUNCTION inchar : CHAR;
VAR  x          : CHAR;
BEGIN
  WITH isc_table[myisc] DO 
  CALL (io_drv_ptr^.iod_rdb ,
         io_tmp_ptr ,
         x);
  inchar:=x;
END;

PROCEDURE out(x:CHAR);
BEGIN
  WITH isc_table[myisc] DO 
  CALL (io_drv_ptr^.iod_wtb ,
         io_tmp_ptr ,
         x);
END;

PROCEDURE output(s    :io_STRING);
VAR i:INTEGER;
BEGIN
  FOR i:=1 to STRLEN(s) DO out(s[i]);
END;

PROCEDURE localbeep; 
BEGIN 
   out(CHR(7));        { send beep to card }
END; 

PROCEDURE dummyupdatecursor; 
BEGIN 
END; 

PROCEDURE dummydbcrt(op : dbcrtops; VAR dbcrt : dbcinfo);
BEGIN END;

PROCEDURE getxy(VAR x,y: INTEGER); 
VAR dummy : CHAR;
BEGIN 
  x:=0;  y:=0;
  { go thru sequence to get actual position }
  out(CHR(esc));        out('`');       { send cursor sense abse   }
  out(CHR(dc1));                        { tell terminal I am ready }
  dummy := inchar;                      { get esc }
  dummy := inchar;                      { get &   }
  dummy := inchar;                      { get '   }
  x     := ORD(inchar)-48;              { get column digit 1 }
  x     := ORD(inchar)-48+x*10;         { get column digit 2 }
  x     := ORD(inchar)-48+x*10;         { get column digit 3 }
  dummy := inchar;                      { get c   }
  y     := ORD(inchar)-48;              { get row    digit 1 }
  y     := ORD(inchar)-48+y*10;         { get row    digit 2 }
  y     := ORD(inchar)-48+y*10;         { get row    digit 3 }
  dummy := inchar;                      { get Y   }
  dummy := inchar;                      { get cr  }
   
  xpos := x;      ypos := y; 
END; 

PROCEDURE setxy(x, y: shortint); 
VAR s : string[9];
    p : INTEGER;
BEGIN 
  IF x>=screenwidth  THEN xpos:=maxx 
                     ELSE IF x<0 THEN xpos:=0
                                 ELSE xpos := x; 
  IF y>=screenheight THEN ypos:=maxy 
                     ELSE IF y<0 THEN ypos:=0 
                                 ELSE ypos := y; 
  
  { send xpos/ypos via escape esc & a xx y yy C }
  SETSTRLEN(s,9);
  STRWRITE (s,1,p,CHR(esc),'&a',ypos:2,'y',xpos:2,'C');
  output   (s);
END; 

PROCEDURE gotoxy(x,y: INTEGER); 
BEGIN
  setxy(x,y); 
  call(updatecursorhook); 
END; 

PROCEDURE remote_crtio (     fp              : fibp; 
                      request         : amrequesttype; 
                      ANYVAR buffer   : window; 
                      length          : INTEGER;
                      position        : INTEGER); 
VAR c   : CHAR; 
    s   : STRING[1];
    buf : charptr; 
    d,e : INTEGER;
BEGIN 
 myisc := unitable^[fp^.funit].sc;
 IF myisc <= 7 THEN myisc := default_isc;
 ioresult := ORD(inoerror); 
 buf := ADDR(buffer); 
 CASE request OF 
  
  setcursor:    BEGIN 
                  gotoxy(fp^.fxpos, fp^.fypos); 
                END;
  
  getcursor:    BEGIN
                  getxy (fp^.fxpos, fp^.fypos);  
                END;
  
  flush:        BEGIN
                  myinit;
                END;
  
  unitstatus:   BEGIN
                   kbdio(fp, unitstatus,buffer,length,position); 
                END;
  
  clearunit:    BEGIN
                  myinit;
                END;
  
  readtoeol:    BEGIN 
                  buf := ADDR(buf^, 1); 
                  buffer[0] := CHR(0); 
                  WHILE length>0 DO BEGIN 
                    kbdio(fp, readtoeol,  s, 1, 0); 
                    IF  STRLEN(s)=0 
                      THEN BEGIN
                        length := 0 
                      END
                      ELSE BEGIN 
                        length := length - 1; 
                        crtio(fp, writebytes, s[1], 1, 0); 
                        buf := ADDR(buf^, 1); 
                        buffer[0] := CHR(ORD(buffer[0])+1); 
                      END; { of IF } 
                  END;     { of WHILE DO BEGIN }
                END;       { of BEGIN }
  
  startread, 
  readbytes:    BEGIN 
                  WHILE length>0 DO 
                    BEGIN 
                    kbdio(fp, readbytes,  buf^, 1, 0); 
                    IF buf^ = CHR(etx) THEN length := 0
                                       ELSE length := length - 1; 
                    IF buf^ = eol 
                      THEN crtio(fp, writeeol,   buf^, 1, 0)
                      ELSE crtio(fp, writebytes, buf^, 1, 0); 
                    buf := ADDR(buf^, 1); 
                    END; 
                  IF request = startread THEN call(fp^.feot, fp); 
                  END; 
  
  writeeol:     BEGIN 
                  IF ypos=maxy 
                    THEN BEGIN 
                       out(CHR(esc));
                       out('S');             { scroll up 1 line }
                  END;
                  gotoxy(0, ypos+1); 
                END; 
  
  startwrite, 
  writebytes:   BEGIN 
                  WHILE length>0 DO BEGIN
                    c:=buf^; buf:=ADDR(buf^,1); length:=length-1; 
                    CASE c OF 
                      
                      homechar: BEGIN
                                  setxy(0,0); 
                                END;
                      
                      leftchar: BEGIN
                                  out(CHR(bs));
                                END;
                      
                      rightchar:BEGIN
                                  getxy(d,e);
                                  IF (xpos = maxx) and (ypos<maxy) 
                                    THEN setxy(0, ypos+1) 
                                    ELSE setxy(xpos+1, ypos); 
                                END;
                                
                      upchar:   BEGIN 
                                  IF (ypos<=1) 
                                    THEN BEGIN
                                      output(CHR(esc) + 'L' + chr(esc) +
                                            '&a0y0C' + chr(esc) + 'K' );
                                      setxy(xpos, ypos);
                                    END;
                                  IF (ypos>0)  
                                    THEN BEGIN
                                      { out(CHR(esc));
                                      out('A'); }
                                      setxy(xpos,ypos-1); 
                                    END;
                                END;
          
                      downchar: BEGIN
                                  IF (ypos=maxy) 
                                    THEN BEGIN
                                      out(CHR(esc));
                                      out('S'); { scroll up 1 line }
                                    END
                                    ELSE BEGIN
                                      { out(CHR(esc));
                                      out('B'); }
                                      setxy(xpos,ypos+1); 
                                    END;
                                END;
                      
                      bellchar: BEGIN
                                  localbeep; 
                                END;
                      
                      cteos:   BEGIN
                                 out(CHR(esc));
                                 out('J');
                               END;
                      
                      cteol:   BEGIN
                                 out(CHR(esc));
                                 out('K');
                               END;
                      
                      clearscr:BEGIN 
                                 setxy(0,0); 
                                 out(CHR(esc)); 
                                 out('J');
                               END; 
         
                      eol:      BEGIN 
                                  out(CHR(cr));
                                  out(CHR(lf));
                                END; 
                      
                      CHR(etx): BEGIN
                                  length:=0; 
                                END;
                      
                      OTHERWISE BEGIN
                                  out(c);  
                                  IF xpos = maxx
                                    THEN BEGIN
                                      IF ypos = maxy 
                                        THEN BEGIN
                                          out(CHR(esc));
                                          out('S'); { scroll up 1 line }
                                        END;
                                      setxy(0,ypos+1);
                                    END
                                    ELSE BEGIN
                                      { setxy(xpos+1,ypos); }
                                      xpos := xpos + 1;
                                    END; { of IF }
                                END;
                                
                    END; { of CASE c OF }
                    call(updatecursorhook); 
                  END; { of WHILE DO BEGIN }
                  IF request = startwrite THEN call(fp^.feot, fp); 
                END; { of startwrite, writebytes case } 
  
  OTHERWISE     BEGIN
                  ioresult := ORD(ibadrequest); 
                END;
                
 END; { of CASE request OF }
END;  { of PROCEDURE crtio }

PROCEDURE dummyproc;
BEGIN
  { nothing }
END;

PROCEDURE crtinit; 
 BEGIN 
   syscom^ := term_environ;
   WITH syscom^.crtinfo DO BEGIN 
     screenwidth:=width;
     screenheight:=height;
     maxx       :=width-1;
     maxy       :=height-1;
     xpos       := 0;
     ypos       := 0;
     crtiohook        := remote_crtio;
     dumpalphahook    := dummyproc;
     dumpgraphicshook := dummyproc;
     togglealphahook  := dummyproc;
     togglegraphicshook := dummyproc;
     updatecursorhook := dummyupdatecursor;
     crtinithook      := crtinit;
     crtllhook        := dummycrtll;
     dbcrthook        := dummydbcrt;
     currentcrt       := specialcrt1;
     bitmapaddr       := 0;
     frameaddr        := 0;
     keybuffer^.echo  := FALSE;
     alphastate       := TRUE;
     graphicstate     := FALSE;
   END; { of WITH DO BEGIN }
 END;   { of PROCEDURE crtinit } 
 
END;   { of MODULE crt }

IMPORT crt,loader;

BEGIN
  crtinit;
  markuser;
END.


@EOF

chmod 666 PAWS.SID.Demos/REMCRT

echo x - PAWS.SID.Demos/REMKEYS
cat >PAWS.SID.Demos/REMKEYS <<'@EOF'
$SYSPROG ON$
$heap_dispose off$ 
$iocheck off$ 
$range off$ 
$ovflcheck off$ 
$debug off$ 
$STACKCHECK OFF$ 


PROGRAM installkeys;

MODULE keys; 

IMPORT sysglobals,sysdevs,asm,misc,iodeclarations,general_0,iocomasm;
 
EXPORT 

 PROCEDURE initkeys;
 
IMPLEMENT

 CONST
  default_isc = 9;
  
  VAR  eol_lying_around : PACKED ARRAY[type_isc] OF BOOLEAN;
       myisc            : shortint;
       newdrivers       : drv_table_type;
       

{ note that you should not use the 'console'
  select code for anything else }

PROCEDURE new_reset(mytemp : ANYPTR);
BEGIN
  { do nothing so that the configuration stays the same }
END;

PROCEDURE myinit;
BEGIN
  IF isc_table[myisc].card_id = hp98628_async 
    THEN iocontrol(myisc,28,0);               { no EOL characters }
  iocontrol(myisc,12,1);                      { connect the card  }
  
  newdrivers := isc_table[myisc].io_drv_ptr^; { copy card dvrs    }
  newdrivers.iod_init := new_reset;           { put in new reset  }
  isc_table[myisc].io_drv_ptr := ADDR(newdrivers); { install drvs }
END;

FUNCTION inchar : CHAR;
VAR     x       : CHAR;
BEGIN
  IF eol_lying_around[myisc] 
    THEN BEGIN 
      inchar := eol;
      eol_lying_around[myisc] := FALSE;
    END
    ELSE BEGIN
      WITH isc_table[myisc] DO 
      CALL (io_drv_ptr^.iod_rdb ,
             io_tmp_ptr ,
             x);
      inchar:=x;
    END;
END;

FUNCTION kbdbusy : BOOLEAN;
VAR     x       : INTEGER;
BEGIN
 WITH isc_table[myisc] DO
  BEGIN
   IF card_id = hp98628_async THEN
    BEGIN
     { check inbound queue for data }
     x:=iostatus(myisc,5);
     IF (x=1) OR (x=3) OR eol_lying_around[myisc] THEN
      kbdbusy:=FALSE
     ELSE
      kbdbusy:=TRUE;
    END;
   IF (card_id = hp98626) or (card_id = hp98644) THEN
    BEGIN
     x:=iostatus(myisc,10); { check character buffer for data } 
     IF bit_set(x,0) OR eol_lying_around[myisc] THEN
      kbdbusy:=FALSE 
     ELSE
      kbdbusy:=TRUE;
    END; 
  END; { WITH isc_table[myisc] DO }
END;


PROCEDURE remote_kbdio (       fp              : fibp; 
                        request         : amrequesttype; 
                        ANYVAR buffer   : window; 
                        length          : INTEGER ;
                        position        : INTEGER); 

VAR   buf               : charptr; 
BEGIN 
 myisc := unitable^[fp^.funit].sc;
 IF myisc <= 7 THEN myisc := default_isc;
 ioresult := ORD(inoerror); 
 buf := ADDR(buffer); 
 CASE request OF 
  
   flush:       BEGIN
                  myinit;
                END;
   
   unitstatus:  BEGIN
                  fp^.fbusy := kbdbusy  ;
                END;
  
   clearunit:   BEGIN 
                  myinit;
                END; 
  
   readtoeol, 
   readbytes,
   startread:   BEGIN 
                  IF request = readtoeol 
                    THEN BEGIN 
                      { the buffer is a string, so set it to empty }
                      buf := ADDR(buf^, 1); 
                      buffer[0] := chr(0); 
                    END; 
                  WHILE length>0 DO BEGIN 
                    buf^ := inchar;
                    IF buf^ = chr(etx)
                      THEN length := 0 
                      ELSE length := length-1; 
                    IF (buf^=eol) and (request=readtoeol) 
                      THEN BEGIN
                        eol_lying_around[myisc] := TRUE;
                        length := 0
                      END
                      ELSE BEGIN 
                        fp^.feoln := FALSE; 
                        buf := ADDR(buf^, 1); 
                        IF request = readtoeol 
                          THEN buffer[0] := CHR(ORD(buffer[0])+1);
                      END;
                  END; { of WHILE DO } 
                  IF request = startread THEN CALL(fp^.feot, fp); 
                END; 
  
   OTHERWISE    BEGIN
                  ioresult := ORD(ibadrequest); 
                END;
 
 END; { of CASE }
END; { of PROCEDURE }

PROCEDURE dummyreq(cmd : byte; VAR value : byte);
BEGIN END;

PROCEDURE dummykbd(VAR statbyte, databyte : byte;
                   VAR doit : BOOLEAN);
BEGIN END;
                   
PROCEDURE dummyproc;
BEGIN END;

PROCEDURE dummyboolproc(b : BOOLEAN);
BEGIN END;

PROCEDURE initkeys; 
VAR localisc  : shortint;
BEGIN 
  kbdiohook       := remote_kbdio;
  kbdreqhook      := dummyreq;
  kbdisrhook      := dummykbd;
  kbdpollhook     := dummyboolproc;
  kbdwaithook     := dummyproc;
  kbdreleasehook  := dummyproc;
  kbdtype         := specialkbd1;
  kbdlang         := ns1_kbd;
  sysmenu         := NIL;
  sysmenushift    := NIL;
  menustate       := m_none;
  FOR localisc := 0 TO 31 DO
   eol_lying_around[localisc] := FALSE;
END;

END;    { of module keys }


IMPORT keys,loader;

BEGIN
  initkeys;
  markuser;
END.


@EOF

chmod 666 PAWS.SID.Demos/REMKEYS

echo Compiling unpacker for non-ascii files
pwd=`pwd`; cd /tmp
cat >unpack$$.c <<'EOF'
#include <stdio.h>
#define DEC(c)	(((c) - ' ') & 077)
main()
{
	int n;
	char dest[128], a,b,c,d;

	scanf("begin %o ", &n);
	gets(dest);

	if (freopen(dest, "w", stdout) == NULL) {
		perror(dest);
		exit(1);
	}

	while ((n=getchar()) != EOF && (n=DEC(n))!=0)  {
		while (n>0) {
			a = DEC(getchar());
			b = DEC(getchar());
			c = DEC(getchar());
			d = DEC(getchar());
			if (n-- > 0) putchar(a << 2 | b >> 4);
			if (n-- > 0) putchar(b << 4 | c >> 2);
			if (n-- > 0) putchar(c << 6 | d);
		}
		n=getchar();
	}
	exit(0);
}
EOF
cc -o unpack$$ unpack$$.c
rm unpack$$.c
cd $pwd

echo x - PAWS.SID.Demos/REVID '[non-ascii]'
/tmp/unpack$$ <<'@eof'
begin 666 PAWS.SID.Demos/REVID
M15A!35!,.B!D:7-C("AP87)T(&]F(#DX-C$U+3@W.3<Q*0TS+C4P+6EN8V@@
M9&ES8SH@.3@V,34M,34S,#0@;W(--2XR-2UI;F-H(&1I<V,Z(#DX-C$U+3$U
M-3 T#5!A<V-A;" S+C O,RXQ(%-Y<W1E;2!);G1E<FYA;',@1&]C=6UE;G0-
-36%R8V@L(#$Y.#8-#3 O
 
end
@eof

chmod 666 PAWS.SID.Demos/REVID

echo x - PAWS.SID.Demos/SERIAL_5
cat >PAWS.SID.Demos/SERIAL_5 <<'@EOF'
$COPYRIGHT 'COPYRIGHT (C) 1982 BY HEWLETT-PACKARD COMPANY'$
$SYSPROG ON$
$PARTIAL_EVAL ON$
$STACKCHECK ON$
$RANGE OFF$
$DEBUG ON$
$OVFLCHECK OFF$
(************************************************************************)
(*                                                                      *)
(*      not released    VERSION         2.0                             *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      IOLIB           extensions                                      *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      library      -  IOLIB                                           *)
(*      name         -  EXTLIB                                          *)
(*      module(s)    -  serial_5                                        *)
(*                                                                      *)
(*      date         -  July 22 , 1982                                  *)
(*      update       -  July 30 , 1982                                  *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)

(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      GENERAL EXTENSIONS                                              *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)

PROGRAM serial_5_init;


MODULE serial_5 ;     

        { date    07/26/82
          update  07/30/82
          
          purpose This module contains the LEVEL 5 HPIB GROUP procedures.   
        }


IMPORT  iodeclarations , iocomasm , general_0  ;  

EXPORT 
  
  TYPE  serial_user_proc = PROCEDURE ( parameter : INTEGER );
  
  TYPE  serial_isr_block = RECORD
                           state : PACKED ARRAY[0..7] OF BOOLEAN;
                           mask  : INTEGER;
                           procs : ARRAY[0..7] OF serial_user_proc;
                           parms : ARRAY[0..7] OF INTEGER;
                         END;
  
  VAR   serial_isr_table : ARRAY[iominisc..iomaxisc] OF ^serial_isr_block;
  
  PROCEDURE on_data    ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_data   ( isc       : type_isc );
  
  PROCEDURE on_prompt  ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_prompt ( isc       : type_isc );
  
  PROCEDURE on_fp_error( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_fp_error(isc       : type_isc );
  
  PROCEDURE on_modem   ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_modem  ( isc       : type_isc );
  
  PROCEDURE on_no_activity
                       ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_no_activity
                       ( isc       : type_isc );
  
  PROCEDURE on_lost_carrier
                       ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_lost_carrier
                       ( isc       : type_isc );
  
  PROCEDURE on_eol     ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_eol    ( isc       : type_isc );
  
  PROCEDURE on_break   ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_break  ( isc       : type_isc );
  
  
IMPLEMENT
  
  CONST data_cond         = 0;     data_mask  =   1;    { data ready   }
        prmpt_cond        = 1;     prmpt_mask =   2;    { prompt       }
        fperr_cond        = 2;     fperr_mask =   4;    { frame/parity }
        mdmch_cond        = 3;     mdmch_mask =   8;    { modem change }
        noact_cond        = 4;     noact_mask =  16;    { no activity  }
        lstcr_cond        = 5;     lstcr_mask =  32;    { lost carrier }
        eol_cond          = 6;     eol_mask   =  64;    { end of line  }
        break_cond        = 7;     break_mask = 128;    { break        }
        
  TYPE coerce = RECORD CASE BOOLEAN OF 
                  TRUE:  ( int : INTEGER );
                  FALSE: ( ptr : ANYPTR )
                END;
  
  PROCEDURE serial_enable      
                       ( isc       : type_isc ;
                         newmask   : INTEGER );
  VAR x : INTEGER;
  BEGIN
    {  There are two interrupt mask areas - the general card interrupt mask
       and the ON INTR interrupt facility within the card's interrupts.  The 
       iocontrol register 13 is the ON INTR mask.  The drv_misc[3] AND 
       iocontrol register 121 is the general card interrupt mask. }
       
    WITH isc_table[ isc ].io_tmp_ptr^ DO BEGIN
      iocontrol ( isc , 13+256 , newmask );             { set ON INTR mask }
      x := ORD( drv_misc[3] );                          { get usr0mask     }
      IF newmask = 0 THEN x := BINAND(x,BINCMP(8))
                     ELSE x := BINIOR(x,8);             
      drv_misc[3] := CHR(x);                            { set/clr bit 3 in } 
                                                        {   usr0mask       }
      iocontrol ( isc , 121+256 , x );                  { set/clr bit 3 in }
                                                        {   ctl reg 121    }
    END; { of WITH DO BEGIN }
  END; { of serial_enable }
  
  
  PROCEDURE serial_isr_allocate
                       ( isc       : type_isc );
  VAR counter : INTEGER;
  BEGIN
    NEW(serial_isr_table[isc] );
    WITH serial_isr_table[isc]^ DO BEGIN
      FOR counter:=data_cond TO break_cond DO state[counter] := FALSE;
      mask := 0;      
    END; { of WITH DO BEGIN }
  END; { of serial_isr_allocate }
  
  PROCEDURE serial_isr_proc
                       ( temp      : ANYPTR  );
  VAR counter : INTEGER;
      happened: BOOLEAN;
      isc     : INTEGER;
      local   : coerce ;
      reason  : INTEGER;
  BEGIN
    local.ptr := temp;                  { coerce to get sc }
    isc       := local.int;
    
    reason := iostatus ( isc , 4 );
    
    { prevent serial_isr_proc in user_isr in temps - to save user doing it }
    serial_enable( isc , 0 );
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
      user_isr.dummy_sl := NIL;
      user_isr.dummy_pr := NIL;
    END; { of WITH isc_table DO BEGIN }
      
    WITH serial_isr_table[isc]^ DO BEGIN
      FOR counter := data_cond TO break_cond DO 
        IF state[ counter ] 
          THEN BEGIN
            happened := bit_set( reason , counter );
            IF happened THEN CALL( procs[counter] , parms[counter] );
          END; { of FOR DO IF bit_set THEN }
      
    { set up serial_isr_proc in user_isr in temps }
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
      user_isr.real_proc := serial_isr_proc;
    END; { of WITH DO BEGIN }
    
    { re - enable interrupts }
    serial_enable( isc , mask );
  
  END; { of WITH BEGIN }
END; { of serial_isr_proc }
  
  PROCEDURE serial_isr_setup
                       ( isc       : type_isc ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER ;
                         which__cond: INTEGER );
  VAR local : coerce;
  BEGIN
    IF ( isc_table[isc].card_id <> hp98628_async ) AND
       ( isc_table[isc].card_id <> hp_datacomm )
      THEN io_escape(ioe_misc,isc);
    IF serial_isr_table[isc] = NIL THEN serial_isr_allocate(isc);
    WITH serial_isr_table[isc]^ DO BEGIN
      { set up procedures & parameters in allocated isr proc block }
      procs[which__cond] := your_proc;
      parms[which__cond] := your_parm;
    
      { set up state _condition and interrupt mask }
      CASE which__cond OF
        data_cond:   mask:=BINIOR(mask,data_mask  );
        prmpt_cond:  mask:=BINIOR(mask,prmpt_mask );
        fperr_cond:  mask:=BINIOR(mask,fperr_mask );
        mdmch_cond:  mask:=BINIOR(mask,mdmch_mask );
        noact_cond:  mask:=BINIOR(mask,noact_mask );
        lstcr_cond:  mask:=BINIOR(mask,lstcr_mask );
        eol_cond:    mask:=BINIOR(mask,eol_mask   );
        break_cond:  mask:=BINIOR(mask,break_mask );
      END; { of CASE }
      state[which__cond] := TRUE;
      
      { set up serial_isr_proc in user_isr in temps }
      WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
        user_isr.real_proc := serial_isr_proc;
        local.int          := isc;              { type coerce }
        user_parm          := local.ptr;        { type coerce }
      END; { of WITH DO BEGIN }
      
      { enable card }
      serial_enable( isc , mask );
    END; { of WITH DO BEGIN }
  END; { of serial_isr_setup }
  
  PROCEDURE serial_isr_kill
                       ( isc       : type_isc ;
                         which__cond: INTEGER );
  BEGIN
    IF serial_isr_table[isc] <> NIL THEN 
    WITH serial_isr_table[isc]^ DO BEGIN
    
      { clear state condition and interrupt mask }
      CASE which__cond OF
        data_cond:   mask:=BINAND(mask,BINCMP(data_mask  ));
        prmpt_cond:  mask:=BINAND(mask,BINCMP(prmpt_mask ));
        fperr_cond:  mask:=BINAND(mask,BINCMP(fperr_mask ));
        mdmch_cond:  mask:=BINAND(mask,BINCMP(mdmch_mask ));
        noact_cond:  mask:=BINAND(mask,BINCMP(noact_mask ));
        lstcr_cond:  mask:=BINAND(mask,BINCMP(lstcr_mask ));
        eol_cond:    mask:=BINAND(mask,BINCMP(eol_mask   ));
        break_cond:  mask:=BINAND(mask,BINCMP(break_mask ));
      END; { of CASE }
      state[which__cond] := FALSE;
      
      { if necessary clear serial_isr_proc in user_isr in temps }
      IF mask=0 THEN WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
        user_isr.dummy_sl := NIL;
        user_isr.dummy_pr := NIL;
        user_parm         := NIL;
      END; { of WITH isc_table DO BEGIN }
      
      { disable or enable card as specified by the _mask  }
      serial_enable( isc , mask );
    END; { of WITH DO BEGIN }
  END; { of serial_isr_kill }
  
  
  PROCEDURE on_data    ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,data_cond );
  END;
  PROCEDURE off_data   ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,data_cond );
  END;
  
  PROCEDURE on_prompt  ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,prmpt_cond );
  END;
  PROCEDURE off_prompt ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,prmpt_cond );
  END;
  
  PROCEDURE on_fp_error( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,fperr_cond );
  END;
  PROCEDURE off_fp_error(isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,fperr_cond );
  END;
  
  PROCEDURE on_modem   ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,mdmch_cond );
  END;
  PROCEDURE off_modem  ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,mdmch_cond );
  END;
  
  PROCEDURE on_no_activity
                       ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,noact_cond );
  END;
  PROCEDURE off_no_activity
                       ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,noact_cond );
  END;
  
  PROCEDURE on_lost_carrier
                       ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,lstcr_cond );
  END;
  PROCEDURE off_lost_carrier
                       ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,lstcr_cond );
  END;
  
  PROCEDURE on_eol     ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,eol_cond );
  END;
  PROCEDURE off_eol    ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,eol_cond );
  END;
  
  PROCEDURE on_break   ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,break_cond );
  END;
  PROCEDURE off_break  ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,break_cond );
  END;
        
END; { of serial_5 }


IMPORT iodeclarations , serial_5;
VAR counter : INTEGER;
BEGIN
  FOR counter := iominisc TO iomaxisc DO 
    serial_isr_table[counter] := NIL;
END.    { of serial_5_init  }  

@EOF

chmod 666 PAWS.SID.Demos/SERIAL_5

echo x - PAWS.SID.Demos/SPECBUFR
cat >PAWS.SID.Demos/SPECBUFR <<'@EOF'
$SYSPROG ON$
PROGRAM specialbuffer(INPUT,OUTPUT);
IMPORT iodeclarations,general_4;
TYPE    short_integer = -32768..32767;
VAR     buffer : buf_info_type;
        stuff  : PACKED ARRAY[0..1023] OF short_integer;
        i,j    : INTEGER;
BEGIN
  iobuffer(buffer,0);                     { set up for 0 bytes }
  WITH buffer DO BEGIN
    buf_ptr := ADDR(stuff);               { set up ptr to data }
    buf_size:= 2048;                      { size in bytes      }
  END; { of WITH DO BEGIN }
  
  FOR j:=0 TO 7 DO BEGIN 
  
    FOR i:=0 TO 1023 DO stuff[i]:=i;      { put data into array }
    
    WITH buffer DO BEGIN
      buffer_reset(buffer);               { to get empty/fill set }
      buf_fill := ADDR(buf_fill,2048);    { mark buffer full }
    END; { of WITH DO BEGIN }
                                          
    transfer(701,serial_fastest,from_memory,buffer,2048);
                                          { send data        }
  END; { of FOR DO BEGIN }
  
END. { of PROGRAM }
@EOF

chmod 666 PAWS.SID.Demos/SPECBUFR

echo x - PAWS.SID.Demos/SRL5TEST
cat >PAWS.SID.Demos/SRL5TEST <<'@EOF'
$SYSPROG ON$
PROGRAM isrtest(INPUT,OUTPUT);
$SEARCH '#3:SERIAL5'$             { or wherever }
IMPORT iodeclarations,general_0,general_1,general_2,
       serial_3,serial_5;

VAR i   : INTEGER;
    isc : INTEGER;

PROCEDURE myproc(temp : INTEGER);
BEGIN
  WRITELN('break received       ISR ');
END;

BEGIN
  isc:=-1;
  FOR i:=0 TO 31 DO IF isc_table[i].card_id=hp98628_async THEN isc:=i;
  WRITELN(isc);
  
  set_baud_rate   (isc,2400);
  set_parity      (isc,odd_parity);
  set_char_length (isc,7);
  set_stop_bits   (isc,1);
  
  iocontrol(isc,12,1);
  
  writestringln(isc,'ready when you are CB - to hit break');
  
  on_break(isc,myproc,0);
  
  i:=0;
  WHILE TRUE DO BEGIN
    i:=i+1;
    WRITELN('waiting ',i:6);
  END;
END.
@EOF

chmod 666 PAWS.SID.Demos/SRL5TEST

chmod 777 PAWS.SID.Demos

rm /tmp/unpack$$
exit 0
