W5RG TITLE 'W5ARG# - WATFIV ARGUMENT LIST CONVERSION ROUTINE' *********************************************************************** * * W5ARG# - CONVERT A WATFIV ARGUMENT LIST TO A * FORTRAN 'G' TYPE ARGUMENT LIST * * WRITTEN BY DAVE EDWARDS, NOV 1972 * * *** NOTICE: THIS SOURCE FILE IS PROVIDED ON AN "AS IS" BASIS, * WITHOUT ANY SUPPORT OR WARRANTY. IF YOU USE IT, YOU DO SO * AT YOUR OWN RISK. YOU MAY USE IT FOR ANY PURPOSE YOU WANT. * * SEE ALSO: WLINK ASSEMBLER MACRO, WHICH GENERATES ENTRY AND RETURN * LINKAGE, INCLUDING A CALL TO THIS ROUTINE. * THE COMBINATION OF WLINK AND W5ARG# MAKES IT QUITE EASY * TO MODIFY AN EXISTING ASSEMBLER ROUTINE TO BE CALLABLE * FROM A WATFIV PROGRAM. * *********************************************************************** SPACE 3 * REFERENCES - FOR A DESCRIPTION OF WATFIV LINKAGE AND * ARGUMENT LISTS, SEE WATFIV IMPLEMENTATION * GUIDE SPACE 3 W5ARG# CSECT SPACE 3 * * REGISTER EQUATES * R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 SPACE 2 FR0 EQU 0 FR2 EQU 2 FR4 EQU 4 FR6 EQU 6 EJECT *********************************************************************** * * CALLING SEQUENCE (STANDARD FORTRAN 'G' LINKAGE) - * * ST R1,ARG STORE INPUT ARGLIST POINTER * L R15,=V(W5ARG#) * LA R1,ARG * BALR R14,R15 * ... * ARG DS F ADDR OF WATFIV ARGLIST * DC A(ARGFT) * DC A(ARGMX) * DC A(ARGLN) * DC A(ARGRT) * DC A(ARGMR) * ... * ARGMX DC F'N' MAX ENTRIES IN ARGFT,-LN (GE 0) * ARGMR DC F'M' MAX ENTRIES IN ARGRT (GE 0) * ARGFT DS (N)F OUTPUT FORTRAN 'G' ARGLIST * ARGLN DS (N)F OUTPUT LENGTH LIST (SEE BELOW) * ARGRT DS (M)F OUTPUT RET.ADDR LIST (SEE BELOW) * * UPON RETURN, R1 HAS ADDR OF NEW ARGLIST (ARGFT) OR * IS ZERO IF THERE ARE NO ARGS. R0 HAS NUMBER OF * ARGUMENTS (0 TO N) * * LENGTH LIST -- FOR EACH ENTRY IN ARGFT, THE CORRESPONDING * WORD IN THE LENGTH LIST ARGLN HAS THE NO. OF BYTES * AVAILABLE FOR MODIFICATION STARTING AT THE ARG ADDRESS. * THIS LENGTH IS 0 FOR UNCHANGEABLE ARGUMENTS (E.G. CONSTANTS, * DO PARAMETERS) AND IS -1 FOR ARGS WHICH ARE SUBROUTINE * OR FUNCTION NAMES * * RETURN ADDR LIST -- FOR EACH STATEMENT NUMBER ARGUMENT, * THE RETURN ADDRESS (I.E. ADDR OF THE STMT) IS PLACED * INTO THE LIST ARGRT * * * NOTES - NO ERRORS ARE DETECTED BY THIS ROUTINE. ALL INPUT * ARGUMENTS ARE CONSIDERED VALID. THE ARGLIST SCAN * IS TERMINATED WHEN END OF INPUT LIST IS FOUND, * OR ARGFT AND ARGRT TABLES ARE BOTH FULL * - THIS ROUTINE DOES NOT DEPEND ON DISPLACEMENTS IN STARTA * *********************************************************************** EJECT * * ENTRY LINKAGE * W5ARG# WLINK CSECT SPACE 3 LM R1,R6,0(R1) GET ARGUMENT ADDRS LA R2,0(0,R2) CLEAR HIGH ORDER BYTE ST R2,AOUT SAVE ADDR OF OUTPUT LIST L R3,0(0,R3) GET MAX OUTPUT ARGS SLL R3,2 MULT BY 4 AR R3,R2 ST R3,EOUT SAVE ADDR OF END OF LIST LA R3,0(0,R4) LA R4,0(0,R5) L R6,0(0,R6) GET MAX RET ADDRS SLL R6,2 MULT BY 4 AR R6,R4 ST R6,ERET SAVE ADDR OF END SR R9,R9 LA R10,4 MVI OUTSW+1,X'F0' SET SWITCHES MVI RETSW+1,X'F0' * * R1 = POINTER IN INPUT ARG LIST * R2 = POINTER IN OUTPUT ARG LIST * R3 = POINTER IN LENGTH LIST * R4 = POINTER IN RET.ADDR LIST * R9 HAS 1ST 3 BYTES ALWAYS ZERO * R10 = 4 * SPACE 3 * * LOOP TO PROCESS THE ARGUMENT LIST * LOOP L R14,0(0,R1) LA R14,0(0,R14) (R14)=THE ADDRESS IC R9,0(0,R1) GET TYPE BYTE SRL R9,4 BRANCH ACCORDING TO SLL R9,2 HIGH ORDER 4 BITS B BTBL(R9) BTBL B CONST 0 UNCHANGEABLE B ENDARG 1 TERMINATOR (SUBROUTINE) B ENDARG 2 TERMINATOR (FUNCTION) B STMT 3 STMT NUMBER B NEXT 4 IGNORE B SUBNAM 5 SUBROUTINE NAME B SUBNAM 6 FUNCTION NAME B NEXT 7 IGNORE B ELEM 8 VARIABLE OR ARRAY ELEMENT B ARRAY 9 ) B ARRAY A ) B ARRAY B ) B ARRAY C ) ARRAY NAME B ARRAY D ) B ARRAY E ) B ARRAY F ) SPACE 3 CONST SR R15,R15 UNCHANGEABLE QUANTITY TM 0(R1),X'08' IS IT CHARACTER TYPE BZ UPOUT NO L R14,0(0,R14) YES, GO 1 DEEPER LA R14,0(0,R14) B UPOUT SPACE 3 STMT C R4,ERET STMT NO. ARG BL RETNF TBL NOT FULL MVI RETSW+1,0 TBL FULL, SET TO NOP B NEXT GO TO NEXT ARG RETNF ST R14,0(0,R4) STORE RETURN ADDR AR R4,R10 UPDATE POINTER B NEXT GO TO NEXT ARG SPACE 3 SUBNAM L R15,SUBCON SUBPROG NAME B UPOUT SPACE 3 ELEM TM 0(R1),X'08' VARIABLE OR ARRAY ELEM BZ ELEM1 BRANCH IF NOT CHAR TYPE IC R9,0(0,R14) SAVE CHAR LENGTH L R14,0(0,R14) GET CHAR ADDR LA R14,0(0,R14) ELEM1 CLI 4(R1),X'8C' IS IT ARRAY ELEM BE ELEM2 YES, GO HANDLE IT TM 0(R1),X'08' CHECK CHAR TYPE AGAIN BO ELEM3 BRANCH IF CHAR TYPE IC R9,0(0,R1) USE TBL TO GET LENGTH N R9,NCON GET VALUE 0 TO 7 SR R15,R15 IC R15,LTBL(R9) B UPOUT ELEM3 LR R15,R9 CHARACTER LENGTH B UPOUT ELEM2 AR R1,R10 ARRAY ELEMENT L R6,0(0,R1) GET ADDR OF STAR ROUTINE L R15,4(0,R6) COMPUTE LENGTH AVAILABLE A R15,8(0,R6) SR R15,R14 SLL R15,8 SRA R15,8 BNM UPOUT CHECK FOR NEGATIVE RESULT SR R15,R15 B UPOUT SPACE 3 ARRAY LM R14,R15,4(R14) ARRAY NAME LA R14,0(0,R14) GET INFO FROM STAR ROUTINE LA R15,0(0,R15) B UPOUT SPACE 3 * * MAKE AN ENTRY IN OUTPUT LIST AND LENGTH LIST * (FROM REGS R14, R15 RESPECTIVELY) * UPOUT C R2,EOUT IS OUTPUT LIST FULL BL OUTNF NO MVI OUTSW+1,0 YES, SET NOP B NEXT LOOK FOR NEXT ARG OUTNF ST R14,0(0,R2) STORE THE ENTRIES ST R15,0(0,R3) AR R2,R10 UPDATE THE POINTERS AR R3,R10 * * PREPARE FOR NEXT ARG * NEXT AR R1,R10 BUMP POINTER OUTSW B LOOP LOOP BACK OR NOP RETSW B LOOP LOOP BACK OR NOP * FALL THROUGH IF BOTH TABLES FULL * * END OF ARGLIST * ENDARG LR R0,R2 L R1,AOUT SET OUTPUT ARGLIST ADDR SR R0,R1 BP SOME SR R1,R1 NO ARGS FOUND B RETURN SOME SRL R0,2 SOME ARGS FOUND S R2,CONF4 MVI 0(R2),X'80' SET END FLAG SPACE 3 * * RETURN LINKAGE * RETURN WLINK RETURN SPACE 3 * * CONSTANTS AND STORAGE * AOUT DS F ADDR OF OUTPUT ARG LIST EOUT DS F ADDR OF END OF OUTPUT LIST ERET DS F END OF RET.ADDR LIST SUBCON DC F'-1' LEN TBL ENTRY FOR SUB NAME LTBL DC AL1(4,1,4,2,4,8,8,16) LENGTH TABLE NCON DC F'7' CONF4 DC F'4' SPACE 3 END