home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Vectronix 2
/
VECTRONIX2.iso
/
FILES_01
/
P_FOTRAN.LZH
/
DEMOS.FOR
/
TOSDEMO.FOR
< prev
next >
Wrap
Text File
|
1987-12-31
|
3KB
|
86 lines
Program Tos
c
c Examples of use of SYS function
c
Call ex1
Call ex2
c
End
Subroutine ex1
c
c Write a string to std. o/p with function 09.
c This requires a 3-word parameter block, containing:-
c word 1: function code,
c words 2-3: address of null-terminated string.
c The variables needed to declare the parameter block are:-
c
Integer*2 pb(3)
Integer*4 pbp
Equivalence (pbp,pb(2))
c
c We shall need to build the null-terminated string somewhere
c and obtain its address with the 'iaddr' function. However,
c in the case of a character expression, 'iaddr' will not give
c the expected result (it gives the address of a descriptor of
c the character expression). As characters are stored one per
c byte in consecutive locations, we can equivalence an integer
c array with the character array and take the address of the
c former (which does not involve any descriptor). Thus we have:-
c
Character str*32, cs*33
Integer*1 ics(33)
Equivalence (ics,cs)
c
c N.B. The preceding equivalence statement will cause a warning
c message to be generated at compilation time.
c Now declare the SYS function and its result code.
c
Integer*4 sys, rc
c
Print *
Print *,'SYS example 1'
10 Print *,'Enter a string (in quotes) <= 32 chars: '
Read (*,*,err=10) str
c
c Now build the parameter block and call SYS.
c
pb(1) = $09
cs = str // char(0)
pbp = iaddr(ics)
c
rc = sys(pb)
c
c N.B. This particular function code returns nothing useful
c in 'rc', but normally one would now examine 'rc' to check
c for possible errors etc.
c
End
Subroutine ex2
c
c Get system version number with function 30.
c This requires a one-word parameter block containing the
c function code. Also declare SYS and its result code.
c
Integer*2 pb(1)
Integer*4 sys, rc
c
c Now the actual result is in the l.s. half of 'rc', with
c the major version in the l.s. byte and the minor version
c in the other byte.
c
Integer*1 brc(4), majorv, minorv
Equivalence (brc,rc), (majorv,brc(4)), (minorv,brc(3))
c
Print *
Print *, 'SYS example 2'
pb(1) = $30
rc = sys(pb)
c
Print 100, majorv, minorv
100 Format(' Majorv=',i3,', Minorv=',i3)
End