From: ARNE@KOPC.HHS.DK (Arne Vajhxj)
Newsgroups: comp.os.vms
Subject: easy to use PASCAL-interface to PPL$-routines
Date: 1 Jan 93 18:18:53 GMT
Distribution: world
Organization: The Internet


Here are some code implementing a simple PASCAL interface for the
PPL$-routines.

So if you not have access to a multi-processor VAX or you do not
program in PASCAL, then skip this posting.

The PPL$-routines are quite OK, but they are very general and therefore
a little difficult to use for the unexperienced programmer.

My routines are very simple to use, but have much less functionality and
a little less efficiency.

The package includes:

  - PAR.MAR and MULTI.PAS which define and implements the interface
  - EX.* which shows how to use it
  - EXBIG*.* which shows how to use it with benefit (including timing results)

                                                              Arne

Arne Vajhxj                             local DECNET:  KO::ARNE
Computer Department                     PSI:           PSI%23831001304030::ARNE
Business School of Southern Denmark     Internet:      ARNE@KO.HHS.DK

================================================================================
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 8.1
$!   On  1-JAN-1993 19:14:22.15   By user ARNE        
$!
$! The VMS_SHARE software that created this archive
$!    was written by  Andy Harper, Kings College London UK
$!    -- September 1992
$!
$! Credit is due to these people for their original ideas:
$!    James Gray, Michael Bednarek 
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. PAR.MAR;1
$!       2. EX.PAS;1
$!       3. EXBIGM.PAS;1
$!       4. EXBIGS.PAS;1
$!       5. FUNC.PAS;1
$!       6. MULTI.PAS;1
$!       7. EX.FOR;1
$!       8. EX.INC;1
$!       9. EX.COM;1
$!      10. EXBIG.COM;1
$!      11. EXBIG.RES;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$unpack: subroutine ! P1=filename, P2=checksum, P3=attributes
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'"
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-UNPACK, Unpacking file ''P1'"
$ n=P1
$ if P3 .nes. "" then $ n=f
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='n'
PROCEDURE GetHex LOCAL x1,x2;x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,
ERASE_CHARACTER(1))-1;RETURN 16*x1+x2;ENDPROCEDURE;
PROCEDURE SkipPartsep LOOP EXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1;
ENDLOOP;ENDPROCEDURE;
PROCEDURE ExpandChar CASE CURRENT_CHARACTER FROM ' ' TO 'z' ["`"]
:ERASE_CHARACTER(1);COPY_TEXT(ASCII(GetHex));[" "]:ERASE_CHARACTER(1);[
OUTRANGE,INRANGE]:MOVE_HORIZONTAL(1);ENDCASE;ENDPROCEDURE;
PROCEDURE ProcessLine s:=ERASE_CHARACTER(1);LOOP EXITIF CURRENT_OFFSET>=LENGTH(
CURRENT_LINE);ExpandChar;ENDLOOP;IF s="V" THEN APPEND_LINE;ENDIF;ENDPROCEDURE;
PROCEDURE AdvanceLine MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);
ENDPROCEDURE;PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=
END_OF(b);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;
ELSE ProcessLine;AdvanceLine;ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,
"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=
GET_INFO(COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,
GET_INFO(COMMAND_LINE,"output_file"));QUIT;
$ if p3 .eqs. "" then $ goto dl
$ open/write fdl &f
$ write fdl "RECORD"
$ write fdl P3
$ close fdl
$ w "-I-CONVRFM, Converting record format to ", P3
$ convert/fdl=&f &f-1 &P1
$dl: delete 'f'*
$ if P2 .eqs. "" then $ goto ckskip
$ checksum 'P1'
$ if checksum$checksum .nes. P2 then $ -
  e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ exit
$ckskip: e "-W-CHKSUMSKIP, checksum validation unavailable for ''P1'"
$ endsubroutine
$start:
$!
$ create 'f'
X`20`20`20`20`20`20`20`20.title`20`20par
X;
X;`20content`20:`20par-routines
X;
X;`20author`20`20:`20Arne`20Vajh`F8j`20(january`201992)
X;
X;-
X;
X;`20`20External`20routines`20(secondary):
X;
X;`20`20`20`20PAR_EXECUTE
X;`20`20`20`20PAR_SYNCH
X;
X;`20`20Internal`20routines:
X;
X;`20`20`20`20par_init
X;`20`20`20`20par_memdef
X;
X;-
X`20`20`20`20`20`20`20`20$DSCDEF
X`20`20`20`20`20`20`20`20$SSDEF
X`20`20`20`20`20`20`20`20$PPLDEF
XTRUE=-1
XFALSE=0
X`20`20`20`20`20`20`20`20.macro`20`20fixdesc,l,a
X`20`20`20`20`20`20`20`20.word`20`20`20l
X`20`20`20`20`20`20`20`20.byte`20`20`20DSC$K_DTYPE_T
X`20`20`20`20`20`20`20`20.byte`20`20`20DSC$K_CLASS_S
X`20`20`20`20`20`20`20`20.address`20a
X`20`20`20`20`20`20`20`20.endm
XNSUB=5
XNBAR=10
XNSEC=10
X`20`20`20`20`20`20`20`20.extrn`20`20LIB$INITIALIZE`20`20`20`20`20`20`20`20`20
V`20;`20include`20LIB$INITIALIZE
X;
X;`20special`20initialization`20section
X;
X`20`20`20`20`20`20`20`20.psect`20`20LIB$INITIALIZE`20long,nopic,con,gbl,noshr,
Vnoexe,nowrt
X`20`20`20`20`20`20`20`20.address`20par_init
X;
X;`20readonly`20data`20section
X;
X`20`20`20`20`20`20`20`20.psect`20`20$PDATA`20quad,pic,con,lcl,shr,noexe,nowrt
Xargl_createapplication:`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20;
V`20argumentlist`20PPL$CREATE_APPLICATION
X`20`20`20`20`20`20`20`20.long`20`20`204
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20size
X`20`20`20`20`20`20`20`20.address`20pardes`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20;`20application-name
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20protection
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20flags
Xargl_getindex:`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20;`20argumentlist`20PPL$GET_INDEX
X`20`20`20`20`20`20`20`20.long`20`20`201
X`20`20`20`20`20`20`20`20.address`20ixadr`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20;`20index
Xargl_spawn:`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20;`20argumentlist`20PPL$SPAWN
X`20`20`20`20`20`20`20`20.long`20`20`206
X`20`20`20`20`20`20`20`20.address`20copies`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20;`20copies
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20program-name
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20children-id's
X`20`20`20`20`20`20`20`20.address`20flags`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20;`20flags
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20input-file
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20output-file
Xargl_exit:`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20;`20argumentlist`20SYS$EXIT
X`20`20`20`20`20`20`20`20.long`20`20`201
X`20`20`20`20`20`20`20`20.long`20`20`20SS$_NORMAL`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20;`20status
Xpardes:`20fixdesc`206,parnam
Xparnam:`20.ascii`20`20"AVUPAR"
Xsecdes:`20fixdesc`207,secnam
Xsecnam:`20.ascii`20`20"PAR_VAR"
Xusrdes:`20fixdesc`205,usrnam
Xflags:`20`20.long`20`20`20PPL$M_NODEBUG
X;
X;`20writeread`20data`20section
X;
X`20`20`20`20`20`20`20`20.psect`20`20$LOCAL`20quad,pic,con,lcl,noshr,noexe,wrt
Xargl_createsharedmemory:`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20;`20ar
Vgumentlist`20PPL$CREATE_SHARED_MEMORY
X`20`20`20`20`20`20`20`20.long`20`20`205
X`20`20`20`20`20`20`20`20.blkl`20`20`201`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20section-name
X`20`20`20`20`20`20`20`20.blkl`20`20`201`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20memory-area
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20flags
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20file-name
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20flags
Xargl_createbarrier:`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20;`20argumentlist`20PPL$CREATE_BARRIER
X`20`20`20`20`20`20`20`20.long`20`20`203
X`20`20`20`20`20`20`20`20.blkl`20`20`201`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20barrier-id
X`20`20`20`20`20`20`20`20.long`20`20`200`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20barrier-name
X`20`20`20`20`20`20`20`20.address`20quorum`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20;`20quorum
Xargl_waitatbarrier:`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20;`20argumentlist`20PPL$WAIT_AT_BARRIER
X`20`20`20`20`20`20`20`20.long`20`20`201
X`20`20`20`20`20`20`20`20.blkl`20`20`201`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20;`20barrier-id
Xcmem:`20`20`20.long`20`20`20mem2-mem1
X`20`20`20`20`20`20`20`20.address`20mem1
Xixadr:`20`20.blkl`20`20`201
Xcopies:`20.blkl`20`20`201
Xquorum:`20.blkl`20`20`201
Xusrnam:`20.ascii`20`20"USERx"
X;
X;`20shared`20data`20section
X;
X`20`20`20`20`20`20`20`20.psect`20`20par_var`20page,pic,ovr,gbl,shr,noexe,wrt
Xmem1:
Xnsect:`20`20.blkl`20`20`201
Xsect:`20`20`20.blkl`20`20`20NSEC
X`20`20`20`20`20`20`20`20.blkl`20`20`20NSEC
Xnproc:`20`20.blkl`20`20`201
Xproc:`20`20`20.blkl`20`20`20NSUB
Xbids:`20`20`20.blkl`20`20`20NBAR
X`20`20`20`20`20`20`20`20.align`20`20page
Xmem2:
X;
X;`20code`20section
X;
X`20`20`20`20`20`20`20`20.psect`20`20$CODE`20quad,pic,con,lcl,shr,exe,nowrt
X;********************
X;
X;`20`20PAR_EXECUTE`20(`20NSECT`20,`20SECTADR`20,`20SECTSIZ`20,`20NPROC`20,`20P
VROC`20,`20OK`20)
X;
X;`20`20start`20parallel`20execution
X;
X;********************
X`20`20`20`20`20`20`20`20.entry`20`20par_execute,`5Em<iv,r2,r3>
X;`20setup`20memory`20control-block
X`20`20`20`20`20`20`20`20movl`20`20`20`20@B`5E4(ap),r0
X`20`20`20`20`20`20`20`20movl`20`20`20`20r0,nsect
X`20`20`20`20`20`20`20`20moval`20`20`20sect,r1
X`20`20`20`20`20`20`20`20movl`20`20`20`20B`5E8(ap),r2
X`20`20`20`20`20`20`20`20movl`20`20`20`20B`5E12(ap),r3
X100$:`20`20`20tstl`20`20`20`20r0
X`20`20`20`20`20`20`20`20bleq`20`20`20`20200$
X`20`20`20`20`20`20`20`20movl`20`20`20`20(r3)+,(r1)+
X`20`20`20`20`20`20`20`20movl`20`20`20`20(r2)+,(r1)+
X`20`20`20`20`20`20`20`20decl`20`20`20`20r0
X`20`20`20`20`20`20`20`20brb`20`20`20`20`20100$
X;`20setup`20subprocess`20control-block
X200$:`20`20`20movl`20`20`20`20@B`5E16(ap),r0
X`20`20`20`20`20`20`20`20movl`20`20`20`20r0,nproc
X`20`20`20`20`20`20`20`20moval`20`20`20proc,r1
X`20`20`20`20`20`20`20`20movl`20`20`20`20B`5E20(ap),r2
X300$:`20`20`20tstl`20`20`20`20r0
X`20`20`20`20`20`20`20`20bleq`20`20`20`20400$
X`20`20`20`20`20`20`20`20movl`20`20`20`20(r2)+,(r1)+
X`20`20`20`20`20`20`20`20decl`20`20`20`20r0
X`20`20`20`20`20`20`20`20brb`20`20`20`20`20300$
X;`20create`20barriers
X400$:`20`20`20addl3`20`20`20#1,nproc,quorum
X`20`20`20`20`20`20`20`20movl`20`20`20`20#NBAR,r2
X`20`20`20`20`20`20`20`20moval`20`20`20bids,argl_createbarrier+4
X500$:`20`20`20callg`20`20`20argl_createbarrier,G`5EPPL$CREATE_BARRIER
X`20`20`20`20`20`20`20`20addl2`20`20`20#4,argl_createbarrier+4
X`20`20`20`20`20`20`20`20decl`20`20`20`20r2
X`20`20`20`20`20`20`20`20tstl`20`20`20`20r2
X`20`20`20`20`20`20`20`20bgtr`20`20`20`20500$
X;`20create`20shared`20memory
X`20`20`20`20`20`20`20`20jsb`20`20`20`20`20par_memdef
X;`20create`20subprocesses
X`20`20`20`20`20`20`20`20movl`20`20`20`20nproc,copies
X`20`20`20`20`20`20`20`20callg`20`20`20argl_spawn,G`5EPPL$SPAWN
X`20`20`20`20`20`20`20`20cmpl`20`20`20`20r0,#PPL$_NORMAL
X`20`20`20`20`20`20`20`20bneq`20`20`20`20600$
X`20`20`20`20`20`20`20`20movl`20`20`20`20#TRUE,@B`5E24(ap)
X`20`20`20`20`20`20`20`20ret
X600$:`20`20`20movl`20`20`20`20#FALSE,@B`5E24(ap)
X`20`20`20`20`20`20`20`20ret
X;********************
X;
X;`20`20PAR_SYNCH`20(`20NR`20)
X;
X;`20`20parallel`20synchronization
X;
X;********************
X`20`20`20`20`20`20`20`20.entry`20`20par_synch,`5Em<iv>
X`20`20`20`20`20`20`20`20movl`20`20`20`20@B`5E4(ap),r0
X`20`20`20`20`20`20`20`20decl`20`20`20`20r0
X`20`20`20`20`20`20`20`20mull2`20`20`20#4,r0
X`20`20`20`20`20`20`20`20moval`20`20`20bids,r1
X`20`20`20`20`20`20`20`20addl3`20`20`20r0,r1,argl_waitatbarrier+4
X`20`20`20`20`20`20`20`20callg`20`20`20argl_waitatbarrier,G`5EPPL$WAIT_AT_BARRI
VER
X`20`20`20`20`20`20`20`20ret
X;********************
X;
X;`20`20par_init
X;
X;`20`20parallel`20execution`20initialization
X;
X;********************
X`20`20`20`20`20`20`20`20.entry`20`20par_init,`5Em<iv,r2>
X`20`20`20`20`20`20`20`20callg`20`20`20argl_createapplication,G`5EPPL$CREATE_AP
VPLICATION
X`20`20`20`20`20`20`20`20moval`20`20`20secdes,argl_createsharedmemory+4
X`20`20`20`20`20`20`20`20moval`20`20`20cmem,argl_createsharedmemory+8
X`20`20`20`20`20`20`20`20callg`20`20`20argl_createsharedmemory,G`5EPPL$CREATE_S
VHARED_MEMORY
X`20`20`20`20`20`20`20`20callg`20`20`20argl_getindex,G`5EPPL$GET_INDEX
X`20`20`20`20`20`20`20`20tstl`20`20`20`20ixadr
X`20`20`20`20`20`20`20`20bneq`20`20`20`20100$
X;`20parent`20process
X`20`20`20`20`20`20`20`20movl`20`20`20`20#SS$_NORMAL,r0
X`20`20`20`20`20`20`20`20ret
X;`20child`20process
X100$:`20`20`20jsb`20`20`20`20`20par_memdef
X`20`20`20`20`20`20`20`20movl`20`20`20`20ixadr,r0
X`20`20`20`20`20`20`20`20decl`20`20`20`20r0
X`20`20`20`20`20`20`20`20mull2`20`20`20#4,r0
X`20`20`20`20`20`20`20`20moval`20`20`20proc,r1
X`20`20`20`20`20`20`20`20addl2`20`20`20r0,r1
X`20`20`20`20`20`20`20`20movl`20`20`20`20(r1),r1
X`20`20`20`20`20`20`20`20calls`20`20`20#0,(r1)
X`20`20`20`20`20`20`20`20callg`20`20`20argl_exit,G`5ESYS$EXIT
X`20`20`20`20`20`20`20`20ret
X;********************
X;
X;`20`20par_memdef
X;
X;`20`20memory`20definition
X;
X;********************
Xpar_memdef:
X`20`20`20`20`20`20`20`20moval`20`20`20usrdes,argl_createsharedmemory+4
X`20`20`20`20`20`20`20`20moval`20`20`20sect,argl_createsharedmemory+8
X`20`20`20`20`20`20`20`20movl`20`20`20`20nsect,r2
X100$:`20`20`20tstl`20`20`20`20r2
X`20`20`20`20`20`20`20`20bleq`20`20`20`20200$
X`20`20`20`20`20`20`20`20addb3`20`20`20#48,r2,usrnam+4
X`20`20`20`20`20`20`20`20callg`20`20`20argl_createsharedmemory,G`5EPPL$CREATE_S
VHARED_MEMORY
X`20`20`20`20`20`20`20`20addl2`20`20`20#8,argl_createsharedmemory+8
X`20`20`20`20`20`20`20`20decl`20`20`20`20r2
X`20`20`20`20`20`20`20`20brb`20`20`20`20`20100$
X200$:`20`20`20rsb
X`20`20`20`20`20`20`20`20.end
$ call unpack PAR.MAR;1 1367008563 ""
$!
$ create 'f'
Xprogram`20ex(input,output);
X
X%INCLUDE`20'MULTI.PAS'
X
Xconst
X`20`20`20k=256000;
X
Xvar
X`20`20`20m`20:`20`5Baligned(9),static`5D`20array`20`5B1..k`5D`20of`20real;
X
Xprocedure`20s1;
X
Xvar
X`20`20`20i`20:`20integer;
X
Xbegin
X`20`20`20synchronize(1);
X`20`20`20for`20i:=1`20to`20(k`20div`204)`20do`20m`5Bi`5D:=m`5Bi`5D+1;
X`20`20`20synchronize(2);
X`20`20`20for`20i:=((k`20div`204)+1)`20to`20(k`20div`202)`20do`20m`5Bi`5D:=m
V`5Bi`5D+1;
X`20`20`20synchronize(3);
X`20`20`20for`20i:=((k`20div`202)+1)`20to`20((3*k)`20div`204)`20do`20m`5Bi`5D:=
Vm`5Bi`5D+1;
X`20`20`20synchronize(4);
X`20`20`20for`20i:=(((3*k)`20div`204)+1)`20to`20k`20do`20m`5Bi`5D:=m`5Bi`5D+1;
X`20`20`20synchronize(5);
X`20`20`20synchronize(6);
Xend;
X
Xprocedure`20s2;
X
Xvar
X`20`20`20i`20:`20integer;
X
Xbegin
X`20`20`20synchronize(1);
X`20`20`20synchronize(2);
X`20`20`20for`20i:=1`20to`20(k`20div`204)`20do`20m`5Bi`5D:=m`5Bi`5D*2;
X`20`20`20synchronize(3);
X`20`20`20for`20i:=((k`20div`204)+1)`20to`20(k`20div`202)`20do`20m`5Bi`5D:=m
V`5Bi`5D*2;
X`20`20`20synchronize(4);
X`20`20`20for`20i:=((k`20div`202)+1)`20to`20((3*k)`20div`204)`20do`20m`5Bi`5D:=
Vm`5Bi`5D*2;
X`20`20`20synchronize(5);
X`20`20`20for`20i:=(((3*k)`20div`204)+1)`20to`20k`20do`20m`5Bi`5D:=m`5Bi`5D*2;
X`20`20`20synchronize(6);
Xend;
X
Xvar
X`20`20`20i`20:`20integer;
X
Xbegin
X`20`20`20writeln(execute_procedures(1,iaddress(m),k*4,2,iaddress(s1),iaddress(
Vs2)));
X`20`20`20for`20i:=1`20to`20(k`20div`204)`20do`20m`5Bi`5D:=1;
X`20`20`20synchronize(1);
X`20`20`20for`20i:=((k`20div`204)+1)`20to`20(k`20div`202)`20do`20m`5Bi`5D:=1;
X`20`20`20synchronize(2);
X`20`20`20for`20i:=((k`20div`202)+1)`20to`20((3*k)`20div`204)`20do`20m`5Bi`5D:=
V1;
X`20`20`20synchronize(3);
X`20`20`20for`20i:=(((3*k)`20div`204)+1)`20to`20k`20do`20m`5Bi`5D:=1;
X`20`20`20synchronize(4);
X`20`20`20synchronize(5);
X`20`20`20synchronize(6);
X`20`20`20writeln(m`5B1`5D,m`5Bk`20div`204`5D,m`5Bk`20div`202`5D,m`5B(3*k)`20di
Vv`204`5D,m`5Bk`5D);
Xend.
$ call unpack EX.PAS;1 406682757 ""
$!
$ create 'f'
Xprogram`20exbigm(input,output);
X
X%INCLUDE`20'FUNC.PAS'
X
X%INCLUDE`20'MULTI.PAS'
X
Xconst
X`20`20`20k=256000;
X
Xvar
X`20`20`20m`20:`20`5Baligned(9),static`5D`20array`20`5B1..k`5D`20of`20real;
X
Xprocedure`20s1;
X
Xvar
X`20`20`20i,t`20:`20integer;
X
Xbegin
X`20`20`20t:=clock;
X`20`20`20synchronize(1);
X`20`20`20for`20i:=1`20to`20(k`20div`204)`20do`20m`5Bi`5D:=f1(m`5Bi`5D);
X`20`20`20synchronize(2);
X`20`20`20for`20i:=((k`20div`204)+1)`20to`20(k`20div`202)`20do`20m`5Bi`5D:=f1(m
V`5Bi`5D);
X`20`20`20synchronize(3);
X`20`20`20for`20i:=((k`20div`202)+1)`20to`20((3*k)`20div`204)`20do`20m`5Bi`5D:=
Vf1(m`5Bi`5D);
X`20`20`20synchronize(4);
X`20`20`20for`20i:=(((3*k)`20div`204)+1)`20to`20k`20do`20m`5Bi`5D:=f1(m`5Bi`5D)
V;
X`20`20`20synchronize(5);
X`20`20`20synchronize(6);
X`20`20`20writeln('S1`20-`20',clock-t);
Xend;
X
Xprocedure`20s2;
X
Xvar
X`20`20`20i,t`20:`20integer;
X
Xbegin
X`20`20`20t:=clock;
X`20`20`20synchronize(1);
X`20`20`20synchronize(2);
X`20`20`20for`20i:=1`20to`20(k`20div`204)`20do`20m`5Bi`5D:=f2(m`5Bi`5D);
X`20`20`20synchronize(3);
X`20`20`20for`20i:=((k`20div`204)+1)`20to`20(k`20div`202)`20do`20m`5Bi`5D:=f2(m
V`5Bi`5D);
X`20`20`20synchronize(4);
X`20`20`20for`20i:=((k`20div`202)+1)`20to`20((3*k)`20div`204)`20do`20m`5Bi`5D:=
Vf2(m`5Bi`5D);
X`20`20`20synchronize(5);
X`20`20`20for`20i:=(((3*k)`20div`204)+1)`20to`20k`20do`20m`5Bi`5D:=f2(m`5Bi`5D)
V;
X`20`20`20synchronize(6);
X`20`20`20writeln('S2`20-`20',clock-t);
Xend;
X
Xvar
X`20`20`20i,t`20:`20integer;
X
Xbegin
X`20`20`20writeln(execute_procedures(1,iaddress(m),k*4,2,iaddress(s1),iaddress(
Vs2)));
X`20`20`20t:=clock;
X`20`20`20for`20i:=1`20to`20(k`20div`204)`20do`20m`5Bi`5D:=f0(i);
X`20`20`20synchronize(1);
X`20`20`20for`20i:=((k`20div`204)+1)`20to`20(k`20div`202)`20do`20m`5Bi`5D:=f0(i
V);
X`20`20`20synchronize(2);
X`20`20`20for`20i:=((k`20div`202)+1)`20to`20((3*k)`20div`204)`20do`20m`5Bi`5D:=
Vf0(i);
X`20`20`20synchronize(3);
X`20`20`20for`20i:=(((3*k)`20div`204)+1)`20to`20k`20do`20m`5Bi`5D:=f0(i);
X`20`20`20synchronize(4);
X`20`20`20synchronize(5);
X`20`20`20synchronize(6);
X`20`20`20writeln('MAIN`20-`20',clock-t);
X`20`20`20writeln(m`5B1`5D,m`5Bk`20div`204`5D,m`5Bk`20div`202`5D,m`5B(3*k)`20di
Vv`204`5D,m`5Bk`5D);
Xend.
$ call unpack EXBIGM.PAS;1 607065469 ""
$!
$ create 'f'
Xprogram`20exbigs(input,output);
X
X%INCLUDE`20'FUNC.PAS'
X
Xconst
X`20`20`20k=256000;
X
Xvar
X`20`20`20m`20:`20array`20`5B1..k`5D`20of`20real;
X
Xvar
X`20`20`20i,t`20:`20integer;
X
Xbegin
X`20`20`20t:=clock;
X`20`20`20for`20i:=1`20to`20k`20do`20begin
X`20`20`20`20`20`20m`5Bi`5D:=f0(i);
X`20`20`20`20`20`20m`5Bi`5D:=f1(m`5Bi`5D);
X`20`20`20`20`20`20m`5Bi`5D:=f2(m`5Bi`5D);
X`20`20`20end;
X`20`20`20writeln('TOTAL`20-`20',clock-t);
X`20`20`20writeln(m`5B1`5D,m`5Bk`20div`204`5D,m`5Bk`20div`202`5D,m`5B(3*k)`20di
Vv`204`5D,m`5Bk`5D);
Xend.
$ call unpack EXBIGS.PAS;1 776165745 ""
$!
$ create 'f'
Xfunction`20f0(i:integer):real;
X
Xbegin
X`20`20`20f0:=sqrt(sqrt(cos(1/i)+sin(1/i)));
Xend;
X
Xfunction`20f1(m:real):real;
X
Xbegin
X`20`20`20f1:=exp(cos(m)+sin(m));
Xend;
X
Xfunction`20f2(m:real):real;
X
Xbegin
X`20`20`20f2:=sin(ln(m+1))+cos(ln(m+1));
Xend;
$ call unpack FUNC.PAS;1 1364810374 ""
$!
$ create 'f'
Xconst
X`20`20`20FTNTRUE`20`20=`20-1;
X`20`20`20FTNFALSE`20=`200;
X`20`20`20NSUB`20=`205;
X`20`20`20NSEC`20=`2010;
X
X
X
Xfunction`20execute_procedures(ll:`5Blist`5D`20integer):boolean;
X
X`5Bexternal`5D`20procedure`20par_execute(%REF`20ns:integer;
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20%REF`20sa:array`20`5Bn1..n2:integer`5D`20of`20integer;
V
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20%REF`20ss:array`20`5Bn3..n4:integer`5D`20of`20integer;
V
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20%REF`20np:integer;
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20%REF`20pa:array`20`5Bn5..n6:integer`5D`20of`20integer;
V
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20%REF`20ok:integer);
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20external;`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
X
Xvar
X`20`20`20i,ns,np,ok`20:`20integer;
X`20`20`20sa,ss`20`20`20`20`20`20:`20array`20`5B1..NSEC`5D`20of`20integer;
X`20`20`20pa`20`20`20`20`20`20`20`20`20:`20array`20`5B1..NSUB`5D`20of`20integer
V;
X
Xbegin
X`20`20`20ns:=argument(ll,1);
X`20`20`20for`20i:=1`20to`20ns`20do`20begin
X`20`20`20`20`20`20sa`5Bi`5D:=argument(ll,2*i);
X`20`20`20`20`20`20ss`5Bi`5D:=argument(ll,2*i+1);
X`20`20`20end;
X`20`20`20np:=argument(ll,2*ns+2);
X`20`20`20for`20i:=1`20to`20np`20do`20begin
X`20`20`20`20`20`20pa`5Bi`5D:=argument(ll,i+2*ns+2);
X`20`20`20end;
X`20`20`20par_execute(ns,sa,ss,np,pa,ok);
X`20`20`20if`20ok=FTNTRUE`20then
X`20`20`20`20`20`20execute_procedures:=true
X`20`20`20else
X`20`20`20`20`20`20execute_procedures:=false;
Xend;
X
Xprocedure`20synchronize(nr:integer);
X
X`5Bexternal`5D`20procedure`20par_synch(%REF`20nr:integer);`20external;
X
Xbegin
X`20`20`20par_synch(nr);
Xend;
X
$ call unpack MULTI.PAS;1 876289697 ""
$!
$ create 'f'
X`20`20`20`20`20`20PROGRAM`20EX
X`20`20`20`20`20`20INCLUDE`20'EX.INC'
X`20`20`20`20`20`20INTEGER*4`20NSEC,NSUB
X`20`20`20`20`20`20PARAMETER`20(NSUB=5,NSEC=10)
X`20`20`20`20`20`20INTEGER*4`20NS,SA(NSEC),SS(NSEC),NP,P(NSUB)
X`20`20`20`20`20`20LOGICAL*4`20OK
X`20`20`20`20`20`20EXTERNAL`20S1,S2
X`20`20`20`20`20`20INTEGER*4`20I
X`20`20`20`20`20`20NS=1
X`20`20`20`20`20`20SA(1)=%LOC(M)
X`20`20`20`20`20`20SS(1)=K*4
X`20`20`20`20`20`20NP=2
X`20`20`20`20`20`20P(1)=%LOC(S1)
X`20`20`20`20`20`20P(2)=%LOC(S2)
X`20`20`20`20`20`20CALL`20PAR_EXECUTE(NS,SA,SS,NP,P,OK)
X`20`20`20`20`20`20WRITE(*,*)`20OK
X`20`20`20`20`20`20DO`20100`20I=1,(K/4)
X`20`20`20`20`20`20`20`20M(I)=1
X100`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(1)
X`20`20`20`20`20`20DO`20200`20I=((K/4)+1),(K/2)
X`20`20`20`20`20`20`20`20M(I)=1
X200`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(2)
X`20`20`20`20`20`20DO`20300`20I=((K/2)+1),((3*K)/4)
X`20`20`20`20`20`20`20`20M(I)=1
X300`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(3)
X`20`20`20`20`20`20DO`20400`20I=(((3*K)/4)+1),K
X`20`20`20`20`20`20`20`20M(I)=1
X400`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(4)
X`20`20`20`20`20`20CALL`20PAR_SYNCH(5)
X`20`20`20`20`20`20CALL`20PAR_SYNCH(6)
X`20`20`20`20`20`20WRITE(*,*)`20M(1),M(K/4),M(K/2),M((3*K)/4),M(K)
X`20`20`20`20`20`20END
XC
X`20`20`20`20`20`20SUBROUTINE`20S1
X`20`20`20`20`20`20INCLUDE`20'EX.INC'
X`20`20`20`20`20`20INTEGER*4`20I
X`20`20`20`20`20`20CALL`20PAR_SYNCH(1)
X`20`20`20`20`20`20DO`20100`20I=1,(K/4)`20
X`20`20`20`20`20`20`20`20M(I)=M(I)+1
X100`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(2)
X`20`20`20`20`20`20DO`20200`20I=((K/4)+1),(K/2)`20
X`20`20`20`20`20`20`20`20M(I)=M(I)+1
X200`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(3)
X`20`20`20`20`20`20DO`20300`20I=((K/2)+1),((3*K)/4)`20
X`20`20`20`20`20`20`20`20M(I)=M(I)+1
X300`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(4)
X`20`20`20`20`20`20DO`20400`20I=(((3*K)/4)+1),K`20
X`20`20`20`20`20`20`20`20M(I)=M(I)+1
X400`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(5)
X`20`20`20`20`20`20CALL`20PAR_SYNCH(6)
X`20`20`20`20`20`20RETURN
X`20`20`20`20`20`20END
XC
X`20`20`20`20`20`20SUBROUTINE`20S2
X`20`20`20`20`20`20INCLUDE`20'EX.INC'
X`20`20`20`20`20`20INTEGER*4`20I
X`20`20`20`20`20`20CALL`20PAR_SYNCH(1)
X`20`20`20`20`20`20CALL`20PAR_SYNCH(2)
X`20`20`20`20`20`20DO`20100`20I=1,(K/4)`20
X`20`20`20`20`20`20`20`20M(I)=M(I)*2
X100`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(3)
X`20`20`20`20`20`20DO`20200`20I=((K/4)+1),(K/2)`20
X`20`20`20`20`20`20`20`20M(I)=M(I)*2
X200`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(4)
X`20`20`20`20`20`20DO`20300`20I=((K/2)+1),((3*K)/4)`20
X`20`20`20`20`20`20`20`20M(I)=M(I)*2
X300`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(5)
X`20`20`20`20`20`20DO`20400`20I=(((3*K)/4)+1),K`20
X`20`20`20`20`20`20`20`20M(I)=M(I)*2
X400`20`20`20CONTINUE
X`20`20`20`20`20`20CALL`20PAR_SYNCH(6)
X`20`20`20`20`20`20RETURN
X`20`20`20`20`20`20END
$ call unpack EX.FOR;1 1481582250 ""
$!
$ create 'f'
X`20`20`20`20`20`20INTEGER*4`20K
X`20`20`20`20`20`20PARAMETER`20(K=256000)
X`20`20`20`20`20`20REAL*4`20M(K)
X`20`20`20`20`20`20COMMON`20/EXCOM/M
$ call unpack EX.INC;1 1093417746 ""
$!
$ create 'f'
X$`20macro`20par
X$`20!
X$`20fortran`20ex
X$`20link`20ex+par+sys$input/opt
Xpsect_attr=excom,page
X$
X$`20write`20sys$output`20"FORTRAN`20example"
X$`20run`20ex
X$`20!
X$`20pascal`20ex
X$`20link`20ex+par
X$`20write`20sys$output`20"PASCAL`20example"
X$`20run`20ex
X$`20!
X$`20exit
$ call unpack EX.COM;1 1868039624 ""
$!
$ create 'f'
X$`20pascal/nolist`20exbigs
X$`20link/nomap`20exbigs
X$`20write`20sys$output`20"START`20S:`20",f$time(),"`20/`20",f$getjpi("","CPUTI
VM")
X$`20run`20exbigs
X$`20write`20sys$output`20"END`20S:`20",f$time(),"`20/`20",f$getjpi("","CPUTIM"
V)
X$`20!
X$`20macro/nolist`20par
X$`20pascal/nolist`20exbigm
X$`20link/nomap`20exbigm+par
X$`20write`20sys$output`20"START`20M:`20",f$time(),"`20/`20",f$getjpi("","CPUTI
VM")
X$`20run`20exbigm
X$`20write`20sys$output`20"END`20M:`20",f$time(),"`20/`20",f$getjpi("","CPUTIM"
V)
X$`20!
X$`20exit
$ call unpack EXBIG.COM;1 441978173 ""
$!
$ create 'f'
X
XResults`20of`20EXBIG`20runs:
X
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20
V`20`20`20`20`20`20`20`20`20elapsed`20`20`20`20CPU`20(1)`20`20`20`20CPU(2)`20
V`20`20`20ratio(3)
X
XmicroVAX`204000`20(1`20CPU)`20`20`20EXBIGS`20`20`20`20`2021.74`20`20`20`20`20
V`2021.31`20`20`20`20`20`2021.04`20`20`20`20`20`200.97
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20EXBIGM
V`20`20`20`20`2026.40`20`20`20`20`20`20`207.02*`20`20`20`20`2022.32`20`20`20
V`20`20`200.85
X
XVAX`206420`20(2`20CPU)`20`20`20`20`20`20`20`20EXBIGS`20`20`20`20`2020.23`20
V`20`20`20`20`2019.82`20`20`20`20`20`2019.52`20`20`20`20`20`200.96
X`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20`20EXBIGM
V`20`20`20`20`2014.28`20`20`20`20`20`20`206.18*`20`20`20`20`2019.98`20`20`20
V`20`20`201.40
X
X(1)`20:`20measured`20outside`20the`20program
X(2)`20:`20measured`20inside`20the`20program
X(3)`20:`20CPU(2)/elapsed
X*`20`20`20:`20only`20main-process`20=>`20useless`20number
X
XConclusions:
X
X`20`20-`20You`20loose`20(example:`2021%)`20by`20using`20the`20routines`20on
V`20a`20single`20CPU`20machine
X`20`20`20`20(no`20surprise`20-`20only`20overhead).
X`20`20-`20You`20gain`20(example:`2029%)`20by`20using`20the`20routines`20on`20a
V`20multi`20CPU`20machine.
X`20`20`20`20Maybe`20not`20proportional`20to`20the`20number`20of`20CPU,`20but
V`20still`20worth`20taking
X`20`20`20`20(and`20remember`20a`2020`20CPU`20seconds`20program`20is`20actually
V`20a`20small`20program,
X`20`20`20`20so`202`20subprocess-creations`20weighs`20relative`20much).
X
$ call unpack EXBIG.RES;1 625752228 ""
$ v=f$verify(v)
$ exit

Newsgroups: comp.os.vms