home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / P_FOTRAN.LZH / DEMOS.FOR / TOSDEMO.FOR < prev    next >
Text File  |  1987-12-31  |  3KB  |  86 lines
  1.         Program Tos
  2. c
  3. c       Examples of use of SYS function
  4. c
  5.         Call ex1
  6.         Call ex2
  7. c
  8.         End
  9.  
  10.         Subroutine ex1
  11. c
  12. c       Write a string to std. o/p with function 09.
  13. c       This requires a 3-word parameter block, containing:-
  14. c               word 1: function code,
  15. c               words 2-3: address of null-terminated string.
  16. c       The variables needed to declare the parameter block are:-
  17. c
  18.         Integer*2 pb(3)
  19.         Integer*4 pbp
  20.         Equivalence (pbp,pb(2))
  21. c
  22. c       We shall need to build the null-terminated string somewhere
  23. c       and obtain its address with the 'iaddr' function. However,
  24. c       in the case of a character expression, 'iaddr' will not give
  25. c       the expected result (it gives the address of a descriptor of
  26. c       the character expression). As characters are stored one per
  27. c       byte in consecutive locations, we can equivalence an integer
  28. c       array with the character array and take the address of the
  29. c       former (which does not involve any descriptor). Thus we have:-
  30. c
  31.         Character str*32, cs*33
  32.         Integer*1 ics(33)
  33.         Equivalence (ics,cs)
  34. c
  35. c       N.B. The preceding equivalence statement will cause a warning
  36. c            message to be generated at compilation time.
  37. c       Now declare the SYS function and its result code.
  38. c
  39.         Integer*4 sys, rc
  40. c
  41.         Print *
  42.         Print *,'SYS example 1'
  43.    10   Print *,'Enter a string (in quotes) <= 32 chars: '
  44.         Read (*,*,err=10) str
  45. c
  46. c       Now build the parameter block and call SYS.
  47. c
  48.         pb(1) = $09
  49.         cs = str // char(0)
  50.         pbp = iaddr(ics)
  51. c
  52.         rc = sys(pb)
  53. c
  54. c       N.B. This particular function code returns nothing useful
  55. c       in 'rc', but normally one would now examine 'rc' to check
  56. c       for possible errors etc.
  57. c
  58.         End
  59.  
  60.         Subroutine ex2
  61. c
  62. c       Get system version number with function 30.
  63. c       This requires a one-word parameter block containing the
  64. c       function code. Also declare SYS and its result code.
  65. c
  66.         Integer*2 pb(1)
  67.         Integer*4 sys, rc
  68. c
  69. c       Now the actual result is in the l.s. half of 'rc', with
  70. c       the major version in the l.s. byte and the minor version
  71. c       in the other byte.
  72. c
  73.         Integer*1 brc(4), majorv, minorv
  74.         Equivalence (brc,rc), (majorv,brc(4)), (minorv,brc(3))
  75. c
  76.         Print *
  77.         Print *, 'SYS example 2'
  78.         pb(1) = $30
  79.         rc = sys(pb)
  80. c
  81.         Print 100, majorv, minorv
  82.   100   Format(' Majorv=',i3,', Minorv=',i3)
  83.         End
  84.                 
  85.  
  86.