*DECK,CALL
          IDENT  CALL 
          TITLE              CALL - CALL STATEMENT PROCESSOR
*CALL     SSTCALL 
          SPACE  3
*** 
*         CALL - CALL STATEMENT PROCESSOR 
* 
*         SYNTAX:     CALL NAME 
*                     CALL NAME(ARG1,ARG2,...,ARGN) 
*                     CALL NAME(ARG1,ARG2,...,ARGN),RETURNS(LABEL1,...) 
* 
          SPACE  3
 B=CALL   RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          EXT       APLRT,CONVERT,DBGAPL,GEFCM,INITR,DARLIST
          EXT    ACALL
          EXT    DOCALL 
          EXT    DOLABR 
          EXT    PH2RETN
          EXT    RSELECT
          EXT       ZFLAG 
  
 SELIST   EQU    32B               POINTS TO NEXT ELIST ELEMENT 
 CDCNT    EQU    37B         CARD NO. OF 2ST CARD OF PRESENT STATEMENT
 MXARGS   EQU    63          MAXIMUM NUMBER OF ARGUMENTS INCLUDING RETS 
  
 IDOP     EQU    1                 ID 
  
*         DEFINE ERROR MESSAGE NUMBERS. 
  
 E317     =      317         TOO MANY ARGUMENTS INCLUDING RETURNS 
 E171     =      171         ILL SYNTAX IN CALL STMT
 E172     =      172         ILL RETURNS PARAMETER
 E182     =      182         RETURNS PARAM IN CALL STMT (NON-ANSI)
  
*         RLIST MACRO NUMBER AND HEADER WORD
  
 M.UCJ    RMEQU  105B        UNCONDITIONAL JUMP MACRO ORDINAL 
 GEFMC    RMEQU  124B 
  
 UCJM     RMHDR  M.UCJ,1
          BSS    1
 GEFM     RMHDR  GEFMC,2
          TITLE 
*         LOCAL AND COMMON STORAGE
  
 TS1      BSSZ   2                 MACRO BUFFER 
 LOCA                              ADDRESS OF CURRENT ARG 
 TYPECLL  ENTRY. 1
 TRCFLG   DATA   1                 TRACE FLAG 
 SRLIST   DATA   0                 START OF RETURNS LIST
 TRCTS    DATA   0                 HOLDS TRACEL INFORMATION 
  
          USE    /CLNFO/           CALL INFO COMMON WITH ARITH,S ACALL. 
 SUBFWA   BSS    1                 ADR OF ENTRY IN SYMTAB OF SUBR CALLED
 SUBH     BSS    1                 H-ORDINAL OF SUBRNAME
 ARGCNT   BSS    1                 HOLDS THE NUMBER OF ARGUMENTS IN LIST
 NARGSF   BSSZ   1                 =0 IF THERE IS AN ARGUMENT LIST
 SUBNAME  BSS    1                 NAME OF CALLED SUBR IN E FORM
 ARLPT    BSSZ      1              ARLIST POINT = NO. OF WORDS IN ARLIST
          USE    *
  
 RETS     VFD    12/2000B+IDOP,48/8HRETURNS 
 ACNT     BSS    1
  
          EJECT 
 CALL     ENTRY.
          RJ     INITR
          RJ     DOCALL 
          MX7    0
          SA7    NARGSF            INITIALIZE 
          SB5    1
          SA2    SELIST            FETCH ADDRESS OF ELIST 
          SA1    X2                FETCH FIRST ELIST ELEMENT
          UX1    B1,X1
          NE     B1,B5,CALLE1 IF NOT A NAME 
          SX6    X2-1              ADVANCE POINTER
          SA6    SELIST            POINT BEYOND NAME
          BX7    X1 
          SA7    SUBNAME           SAVE SUB NAME
          SA1    SELIST            ITEM AFTER NAME
          SA2    X1 
          UX0    B1,X2
          SX6    X1-1 
          SB2    EL.( 
          SB3    EL.EOS 
          EQ     B1,B2,CALL1       IF ( 
          EQ     B1,B3,CALL0       IF EOS 
          SB2    EL.COMMA 
          EQ     B1,B2,CALL0       IF , 
          EQ     CALLE1 
  
 CALL0    SA6    NARGSF            SET NO ARGS FLAG 
          EQ     CALL2
 CALL1    SA6    SELIST            POINT BEYOND ( 
 CALL2    RJ     ACALL
          SA6    TRCFLG 
          SA1    SELIST            WHAT IS NEXT E - 
          SB2    EL.EOS 
          SA2    X1 
          SB3    EL.COMMA 
          UX0    B1,X2
          SX6    X1-1              UP SELIST
          SA6    SELIST 
          EQ     B1,B2,CALL30      IF END OF STATE. 
          NE     B1,B3,CALLE2 IF NOT A COMMA
  
*         OUTPUT RLIST OP TO ASSEMBLE A FULL WORD OF ZERO IN APLIST 
  
          MX1    1
          LX1    1+AP.STP 
          MX2    0
          IX3    X3-X3
          MX4    0
          CALL   APLRT       OUTPUT A -0 APLIST WORD
  
          SA1    SELIST            IS NEXT E RETURN - 
          SA2    X1 
          SA3    RETS 
          IX4    X2-X3
          NZ     X4,CALLE1   IF NOT *RETURNS* 
          BX6    X3 
          SA3    ARGCNT 
          BX7    X3 
          SA6    A3 
          SA7    ACNT 
          SA6    =XRETURNS         SET FLAG FOR PASS 2
          SA2    A2-1              NEXT E ( - 
          SB2    EL.( 
          UX0    B1,X2
          NE     B1,B2,CALLE3 IF NOT A LEFT PAREN 
          SX7    A2-1 
          SA7    SRLIST            SAVE START OF LABELS ADDRESS 
 CALL44   SA2    A2-1              IS NEXTE A LABEL (CONST) - 
          UX0    B1,X2
          NZ     B1,CALLE4   IF NOT A CONSTANT
          SA3    ACNT 
          SX7    X3+1 
          SA7    A3 
          SX6    A2                A2 POINTS TO LABEL 
          AX0    48-3              IS TYPE INT -
          MX1    60-3 
          SA6    SELIST 
          BX3    -X1*X0 
          SX0    X3-T.INT 
          ZR     X0,CALL43   IF TYPE INTEGER
  
          POSTERR  NR=E172,SEV=FE,FMT=ELIST,TXT=X2,RETURN=PH2RETN 
  
*         FORM RLIST INSTR TO MAKE APLIST ENTRY FOR THIS LABEL
  
 CALL43   SA1    TRCFLG 
          NZ     X1,CALL42         BRANCH IF NO TRACING 
          SA1    =XTRACEL 
          MX7    0
          BX6    X1 
          SA7    A1                TEMPORARY TRACEL VALUE 
          SA6    TRCTS             SAVE TRACEL INFORMATION
          RJ     DOLABR            GO PROCESS LABEL 
          MX0    60-L.TRO 
          LX2    60-P.TRO          POSITION LABEL TABLE ORDINAL 
          BX7    -X0*X2            USED FOR EQ VFD WORD 
          SX1    B1                ORDINAL FOR LABEL
          LX7    18 
          BX7    X7+X1             BUILD INFORMATION WORD FOR LATER 
          SA1    =XN.GL 
          SX2    X1+I.GL     IH  = GL(NGLN) 
          LX7    18 
          SX6    X1+B5             INCREMENT NGLN 
          BX7    X7+X1             BUILD INFORMATION WORD FOR LATER 
          SA6    A1 
          SA3    TRCTS
          BX6    X3 
          SA6    TRACEL            RESTORE OLD VALUE
          SA4    SELIST 
          SA7    X4                SAVE INFORMATION WORD
          SB1    X2 
          EQ     CALL45 
  
 CALL42   CALL   DOLABR 
  
 CALL45   MX1    0           ST = 0 
          SX2    B1          IH 
          MX3    0           CA = 0 
          IX4    X4-X4       NO DIM CHECK 
          CALL   APLRT       APLIST FOR RETURNS LABEL 
  
          SA1    SELIST            IS NEXT EA , - 
          SA2    X1-1 
          UX0    B1,X2
          SB2    EL.COMMA 
          SB3    EL.) 
          EQ     B1,B2,CALL44      IF YES (A2 USED BY CALL44) 
          NE     B1,B3,CALLE3  IF NOT LEFT PARENTHESIS
          SA1    A2-1              IS NEXT E EOS -
          SB1    EL.EOS 
          UX0    B2,X1
          NE     B1,B2,CALLE4  IF NOT EOS 
          SA4    SELIST 
          SA5    ACNT 
          SX7    X5-MXARGS-1
          PL     X7,CALLE6   IF MORE THAN MXARGS ARGUMENTS
          POSTER SEV=ANSI,NR=E182,FMT=ELIST,TXT=X4+1
  
 CALL30   SA5    RSELECT
          ZR     X5,CALL31
          ADDREF SUBH,REF          ADD A REFERENCE FOR THE NAME 
  
 CALL31   MX6    0
          SA6    DBGAPL 
          SX7    SUBNAME
          SA7    A6+1 
          SA1    A6 
          PLUG   AT=IGCALL,TO=RTNS
          SA2    ARGCNT 
          ZR     X2,IGCALL3        IF NO ARGS, GO OUTPUT 60-BIT RJ
  
          SA2    =XN.AP 
          SX6    X2+1 
          BX7    X2 
          SA6    A2 
          SA7    TS1
          EQ     IGCALL4
  
*         RETURN TO PROCESS RETURN
  
 RTNS     SA1    TYPECLL
          NZ     X1,RTNS. 
          SX6    1
          SA6    A1 
          SA1    CDCNT
          SX7    X1+1              INCREMENT LINE NUMBER FOR RETURNS
          SA7    A1 
          RJ     FARGLST           FORM DEBUG ARG LIST
          SA1    CDCNT
          SX7    X1-1              RESTORE FORMER LINE COUNT
          SA7    A1 
 RTNS.    MX4    0
          SA5    ARLPT
          RJ     DARLIST           WRITE MACRO ONTO RLIST FILE
  
*         PROCESS RETURNS LIST FOR DEBUG MODE 
  
          SA1    SRLIST 
          ZR     X1,CALL           EXIT IF NO RETURNS LIST
          SA2    TRCFLG 
          NZ     X2,RESET          EXIT IF NO TRACING 
          SA3    DBGAPL 
          BX6    X3 
          SA6    TS1               SAVE SUBNAME ORDINAL 
          SA2    N.GL 
          SX6    X2+I.GL     IH = GL(NGLN)
          SA6    UCJM+1 
          WRM    UCJM        OUTPUT UJP MACRO TO RLIST
  
 NXTLAB   SA1    TS1
          SX2    X1          IH(CON.) 
          AX1    30 
          LX1    AP.CAP 
          BX6    X1+X2
          SA6    =XAPLST+1
          WRM    APLST
          SA1    SRLIST 
          SA3    =XLABEL. 
          SA2    X1 
          LX2    -36
          SX4    X2-1        CA 
          LX4    AP.CAP 
          BX6    X3+X4
          SA6    =XAPLST+1
          WRM    APLST
          SA3    SRLIST 
          SA4    X3 
          BX6    X4 
          AX6    18          POSITION RN OF DESTINATION LABEL 
          SX5    X4+I.GL
          SA6    UCJM+1 
          CALL   WLABM
          SYMBOL =8RBUGCLR
          SA3    =XDBGEXT 
          BX7    X2+X3       SET CGS AND EXT BITS 
          SA7    A2 
          SA1    =XN.AP 
          SX3    B1 
          SX7    X1+B5       INCREMENT N.AP 
          SX2    X1+I.AP
          SA5    GEFM 
          LX2    RM.IHL 
          SA7    A1 
          BX7    X5 
          SA4    CDCNT
          SA7    DBGAPL      STORE GEF MACRO HEADER 
          BX6    X2+X3       CREATE 1ST WORD OF GEF PARAMETERS
          BX7    X4 
          SA6    A7+B5
          SA7    A6+B5
          WRM    DBGAPL 
          WRM    UCJM 
          SA1    SRLIST 
          SA2    X1-1              GET NEXT ELEMENT 
          SB5    1
          UX0    B1,X2
          SB2    EL.) 
          EQ     B1,B2,LABEL       ADD LABEL IF FINISHED
          SX6    A2-B5
          SA6    SRLIST            UPDATE POINTER 
          EQ     NXTLAB            GO PROCESS NEXT LABEL
  
 LABEL    SA2    N.GL 
          SX7    X2+B5       NGLN = NGLN + 1
          SA7    A2 
          SX5    X2+I.GL
          CALL   WLABM       #GLNNN LABEL DEF TO RLIST
 RESET    MX6    0
          SA6    SRLIST            RESET POINTER
          EQ     CALL              EXIT 
  
*         ERROR PROCESSING. 
  
 CALLE1   SB4    0           (SELIST) POINTS AT ERROR 
          EQ     CALLE5 
  
 CALLE2   SB4    1           (SELIST) POINTS PAST ERROR 
          EQ     CALLE5 
  
 CALLE3   SB4    -1          (SELIST) POINTS BEFORE ERROR 
          EQ     CALLE5 
  
 CALLE4   SB4    -2          (SELIST) POINTS 2 BEFORE ERROR 
  
 CALLE5   SA1    SELIST 
          POSTER SEV=FE,NR=E171,FMT=ELIST,TXT=X1+B4,RETURN=PH2RETN
  
 CALLE6   POSTER SEV=FE,NR=E317,FMT=ELIST,TXT=X4+1,RETURN=PH2RETN 
          EJECT 
*** 
*         FARGLST: FORM ARGLIST FOR DEBUG CALLS 
*                  TYPECLL = 0 FOR CALL TRACING 
*                            1 FOR NORMAL RETURNS TRACING 
* 
  
 FLA      BSS    1
  
 FARGLST  ENTRY. **                ENTRY/EXIT 
          SA1    SUBNAME           SUBNAME IN E-LIST FORM 
          LX1    12                POSITION AT TOP OF REGISTER
          CALL   STRIP             REMOVE POSSIBLE TRAILING $ 
          SB1    1
          RJ     CONVERT           PLACE WORD IN CONS TABLE 
          BX6    X1 
          SA6    DBGAPL            BEGIN BUILDING ARG LIST TABLE
          MX7    0
          SA1    TYPECLL
          SX6    =8RBUGCL1
          ZR     X1,FAR2     IF TRACE PRECEDES ACTUAL CALL
          SX6    =8RBUGCL2
 FAR2     SA7    A6+B1
          SA6    A7+B1
          SA1    =XSTAPLC 
          BX6    X1 
          SA7    A1          NO STORE TO APLIST CHAIN POINTER FOR DEBUG 
          SA6    FLA
          SA1    DBGAPL 
          SA2    N.AP 
          BX6    X2 
          SX7    X2+1 
          SA7    A2 
          RJ     IGCALL            GENERATE CALL MACRO
          SA2    DBGAPL+2    (X2) = ADDR OF DEBUG ROUTINE NAME
          SYMBOL X2,*+1-*P/60D     SYMBOL GUARANTEED TO BE IN SYMTAB
          SX6    T.CGS             PLACE TYPE CGS IN SYMTAB WORD
          LX6    P.TYP                SO REFERENCE WONT APPEAR IN 
          BX7    X6+X2                THE REFERENCE MAP 
          SA7    A2 
          SA1    FLA
          BX6    X1 
          SA6    STAPLC 
          EQ     FARGLST
          TITLE              IGCALL - INTERNALLY GENERATED CALL 
*** 
*         IGCALL - FORM AND WRITE RLIST FOR A SUBROUTINE CALL 
* 
*         ENTRY:  
*                A1 = ADDRESS OF THE PARAMETER LIST 
*                X6 = APLIST NUMBER FOR ARG LIST, IF ANY
*                FORMAT OF THE PARAMETER LIST IS: 
*                12/0,18/CA,30/IH FOR ARG N , ... 
*                A ZERO WORD
*                VFD  60/=8R_SUBROUTINE NAME
* 
 IGCALL2  MX0    1                 NOT IN TABLE 
          LX0    1+P.EXT
          BX7    X0+X2             SET EXTERNAL BIT 
          SA7    A2 
  
          SA1    TS1               APLIST NUMBER/0
          SX2    B1                IH OF FUNCTION 
          SA5    A1+B5
          SA4    =XSTAPLC 
          SA3    CDCNT       LINE COUNT 
          RJ     GEFCM
          RJ     DOCALL            INFORM DOPROC OF EXTERNAL CALL 
  
 IGCALL   ENTRY.
          MX7    0
          ZR     X1,IGCALL3        IF NO ARGS 
  
          SA6    TS1
 IGCALL.L SX6    A1+1 
          MX0    30 
          SA6    LOCA              SAVE NEXT WORD ADDRESS 
          BX3    X0*X1             EXTRACT CA 
          LX3    30 
          BX2    -X0*X1            EXTRACT IH 
          MX1    0
          IX4    X4-X4
          RJ     APLRT
          SA2    LOCA 
          SA1    X2 
          NZ     X1,IGCALL.L       LOOP IF MORE ARGS
  
*         FORM RLIST FOR  SA1  [APN 
  
 IGCALL4  MX6    0
          SA6    TS1+1
  
*         FORM A RETURN JUMP TO THE SUBROUTINE
  
 IGCALL1  SA2    A1+1              ADDRESS OF SUB NAME
          SA1    X2                FETCH NAME 
          SYMBOL ,IGCALL2          ENTER NAME IN SYMTAB 
  
 IGCALL3  SX6    A1 
          SA6    LOCA              SAVE ADDR OF DBGAPL
          MX1    0
          SA2    ZFLAG
          ZR     X2,IGCALL5        IF NO ZERO WORD LOAD REQUIRED
          SB1    2
          MX2    0
          CALL   CONVERT     DOUBLE ZERO WORD IN CONTAB ( FOR ADDSUB LP 
          SX2    I.AP 
 IGCALL5  MX0    30 
          BX6    -X0*X1            IH OF CON. 
          IX6    X6-X2
          SA6    TS1
          BX7    X0*X1             CA 
          LX7    30 
          SA7    A6+1 
          SA2    LOCA              RESTORE ADDR OF DBGAPL 
          SA1    X2 
          EQ     IGCALL1
          END 
