Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
decus/20-0019/fake.mac
There are 2 other files named fake.mac in the archive. Click here to see a list.
00100 TITLE FAKE - A SET OF F IV ROUTINES TO FAKE DYNAMIC ARRAY ASSIGNMENTS
00200 SUBTTL DYNDIM - PJ HAGAN, JAN 70.
00300
00400 ;THE PACKAGE INCLUDES THE FOLLOWING ROUTINES
00500 ;A) DYNDIM ALLOCATES CORE TO ARRAY AND STORES ARRAY ADDRESS IN
00600 ; DUMMY ARRAY NAME
00700 ;B) FAKE TRANSFERS CALLS FROM PROGRAM TO SUBROUTINE AFTER DOCTORING
00800 ; LINKS TO DYNAMIC ARRAYS
00900 ;C) SETJFF DOES BOOKEEPING TO ALLOW RETURN OF DYNAMIC ARRAY
01000 ; SPACE.
01100 ;Converted to FORTRAN-20 standard 12 August 1980
01200 ;by Paul T. Robinson, Wesleyan Univ, DECUS conversion programmer
01300 ;ACCUMULATORS
01400 A=0
01500 B=1
01600 C=2
01700 D=3
01800 E=4
01900 P=17
02000
02100 ;PARAMETERS
02200 OUTSTR=3
02300
02400 ;SUBROUTINE DYNDIM
02500 ;ALLOCATE CORE TO DYNAMIC ARRAY
02600 ;CALL DYNDIM (A,ID,IFLAG)
02700 ; WHERE A IS A DUMMY ARRAY NAME
02800 ; ID IS THE NUMBER OF CORE LOCATIONS REQUIRED FOR ARRAY
02900 ; IFLAG RETURNS TO USER
03000 ; =0 O.K. RETURN
03100 ; =-1 IF NO CORE AVAILABLE
03200 ; =+1 IF ZERO OR NEGATIVE ARRAY LENGTH REQUESTED
03300
03400
03500 ;EXTERNAL JOBFF,JOBREL
03600 external .jbff, .jbrel
03700 jobff==.jbff
03800 jobrel==.jbrel ;jobdat symbols changed names
03900
03950 OPDEF pjrst [jrst]
04000 ENTRY DYNDIM
04100
04200 MLON
04300
04400 DYNDIM: SETZM @2(16) ;CLEAR FLAG
04500 HRRZ A,JOBFF
04600 MOVE B,@1(16) ;GET LENGTH OF ARRAY
04700 JUMPLE B,DYNNEG ;AN ARRAY OF NEGATIVE LENGTH REQUESTED
04800 ADD B,A
04900 HRRZ C,JOBREL ;HIGHEST LOCATION OF USER'S CORE
05000 CAMG B,C ;WILL ARRAY FIT?
05100 JRST DYDIM1 ;YES!
05200 MOVE C,B
05300 CALLI C,11 ;NO! CORE UUO
05400 JRST DYDIM2 ;ERROR RETURN
05500
05600 DYDIM1: MOVEM A,@(16) ;STORE ADR OF ARRAY IN DUMMY
05700 MOVEM B,JOBFF ;UPDATE FIRST FREE
05800 SETZM @A ;ZEROISE FIRST WORD IN ARRAY
05900 HRLS A ;SET UP BLOCK TRANSFER TO
06000 AOS A ;ZEROISE ARRAY
06100 BLT A,(B)
06200 popj p, ;return
06300
06400 DYDIM2: MOVEI A,[ASCIZ /CORE AVAILABLE, BUT NOT TO YOU
06500 /]
06600 SKIPN C
06700 MOVEI A,[ASCIZ /NO CORE AVAILABLE
06800 /]
06900 TTCALL OUTSTR,@A
07000 SETOM @2(16)
07100 popj p, ;return
07200
07300 DYNNEG: MOVEI B,[ASCIZ /ARRAY LENGTH < OR = 0 REQUESTED
07400 /]
07500 TTCALL OUTSTR,@B
07600 MOVEI B,1
07700 MOVEM B,@2(16) ;SET IFLAG
07800 popj p, ;return
07900
08000 ;SUBROUTINE SETJFF
08100 ;ROUTINE WHICH ALLOWS A USER TO SAVE AND RESTORE JOBFF
08200 ;N.B. BEFORE RESTORING JOBFF THE USER MUST RELEASE ALL DEVICES WHICH
08300 ;HAVE SET UP BUFFERS SUBSEQUENT TO SAVING JOBFF
08400 ;CALL SETJFF (NCOR)
08500 ; WHERE NCOR IS SET INITIALLY TO ZERO, BUT ON THE FIRST CALL TO
08600 ; THIS SUBROUTINE IS SET NON-ZERO THUS INICATING JOBFF HAS
08700 ; BEEN SAVED.
08800
08900 ENTRY SETJFF
09000
09100 SETJFF: SKIPE @(16) ;FIRST ENTRY?
09200 JRST SETJF1 ;NO!
09300 MOVE A,JOBFF ;YES!
09400 MOVEM A,JOBKP#
09500 SETOM @(16) ;MARK AS SAVED
09600 popj p, ;return
09700
09800 SETJF1: MOVE A,JOBKP ;RESTORE ORIGINAL JOBFF
09900 MOVEM A,JOBFF
10000 popj p, ;return
10100
10200
10300
10400 ;SUBROUTINE FAKE
10500 ; THIS ROUTINE AS AN INTERMEDIATE ROUTINE BETWEEN A PROGRAM
10600 ;AND ITS SUBROUTINE. IT FAKES ARRAY ADDRESSES TO ALLOW THE SUBROUTINE
10700 ;TO USE DYNAMICALLY DIMENSIONED ARRAYS.
10800 ;
10900 ;CALL FAKE (I,J,SUBPR,ARRAY1,ARRAY2.....,ARG1,ARG2,ARG3.....)
11000 ; WHERE I IS THE NO OF DYNAMIC ARRAY DUMMIES, ARRAYN.
11100 ; J IS THE TOTAL NUMBER OF ARGUMENTS FOR THE SUBROUTINE
11200 ; CALL TO BE GENERATED BY FAKE.
11300 ; SUBPR IS THE SUBROUTINE NAME, DEFINED IN THE FORTRAN
11400 ; PROGRAM IN A EXTERNAL STATEMENT
11500 ; ARRAYN ARE THE DYNAMICALLY DEMENSIONED ARRAY DUMMIES
11600 ; ARGN ARE THE REST OF THE ARGUMENTS NEEDED FOR THE
11700 ; SUBROUTINE CALL.
11800
11900 ENTRY FAKE
12000
12100 FAKE: MOVN B,@(16) ;GET NO OF DYNAMICALLY DIMENSIONED ARRAYS
12200 HRLI B,3(16) ;GET ADDRESS FIRST DUMMY
12300 MOVSS B
12400 MOVN C,@1(16) ;GET NO OF ARGS
12500 ; HRLI C,FAKE3+1 ;POSITION FOR ARG IN CALL STR
12600 hrli c,fake4 ;start of arg block
12700 MOVSS C ;COUNTER AND INDEX
12800
12900 FAKE1: MOVE A,@(B) ;GET ARRAY ADR
13000 HLL A,(B) ;SET ARG DESCRIPTION
13100 MOVEM A,(C) ;PLACE IN NEW CALL STRING
13200 AOBJP C,FAKE5 ;DONE LAST ARGUMENT
13300 AOBJN B,FAKE1 ;REPEAT FOR EACH ARRAY
13400
13500 FAKE2: MOVE A,(B)
13600 MOVEM A,(C) ;TRANSFER ARGS
13700 AOS B
13800 AOBJN C,FAKE2 ;GET NXT ARG
13900
14000 FAKE5: HRR A,2(16) ;SET UP SUBROUTINE ADDRESS
14100 ; HRRM A,.+1
14200 ;
14300 ;FAKE3: JSA 16,0 ;ISSUE CALL
14400 ; REPEAT 20,< ;ROOM FOR 20 ARGUMENTS
14500 ; JUMP 00,0
14600 ;>
14700 ; JRA 16,4(16) ;RETURN TO MAINLINE
14800
14900 fake3: movei 16,[exp fake4]
15000 pjrst @a ;issue call, return
15100
15200 fake4: block ^d20 ;room for 20 args
15300
15400 END