*DECK INIT
          IDENT  INIT 
 INIT     SECT   (TS MODE INITIALIZATION) 
  
          SST    A,EXIT.
          NOREF  A,EXIT.
  
 B=INIT   RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  ADWT,DPTA,EQUA,SCR,SAVE,FCA
          ENTRY  DECA,HOLLSKL,SCR2,TRVA,AGNK,CALLTAG,BIAS,CON1
          ENTRY  CON2,CLOSREP,DA,DATEMP,DATEMPL,DIM,DIM.MUL,DLEN,DVT
          ENTRY  INDX,INC,I.DIT,LI,LL,LPINF,MP,NONANSI,N.DIMS,N.ITEM
          ENTRY  N.SUBS,N.VSUB,ORD,ORGI,PL,REPFLAG,RL,SDPF,SELIST,SIGN
          ENTRY  SST1,SSTL,SUBN,TEMP,TMP,UL,FORSKEL,OSTACK
          ENTRY  FWAASF,FWAARG,FWAREF,SVB6,CDOTG,ESTACK,ASFERR
          ENTRY  ASFARG,CST.BOS 
          ENTRY  FTO
  
*         IN FTN
          EXT    CO.RND,CP.CARD,CP.PAGE,CP.PD,LCP.PS
          EXT    FV.LGO,F.IN,F.LF,F.LGO,F.OUT,F.RMAP
          EXT    LOP=O,LOP=R,LOP=X,PLIMIT,TIME1 
  
*         IN TABLES 
          EXT    BINIO,CDD,REFIO
  
*         IN ERRORS 
          EXT    ANSI.SW
  
*         IN BATCH
          EXT    RUN.X
  
*         IN HEADER 
          EXT    PPAD 
  
*         IN PIG
          EXT    WIN
  
*         IN END
          EXT    BT.IDNT,BT.IDN9
  
*         IN ALLOC
          EXT    ERT
  
*         IN MAIN 
          EXT    AFSA 
  
 FIRSTLIT LIT    0LFIRSTLIT.
  
  
 BSSX     BSS    0           BASE ADDRESS OF SCRATCH CELLS
 BSSX.    SET    0
 FCA      SPACE  4,8
**        FCA -  FINISHED WITH COMPASS ASSEMBLY.
* 
*         ENTRY  THE (1,0) HAS JUST BEEN RELOADED AFTER RETURNING FROM
*                *COMPASS*, AND THE INPUT FILE IS NOT FINISHED. 
* 
*         EXIT   TO *RUN1* TO BEGIN NEXT PROGRAM-UNIT.
* 
*         CALLS  IMO
  
  
 FCA      BSS    0           ENTRY... 
          RJ     IMO         INITIALIZE MASTER OVERLAY
  
**        SET UP (CP.CARD) THE WAY *RNC* WOULD HAVE.
*                INSURE THAT THE END-OF-LINE TERMINATOR IS EXACTLY 10 
*                ZERO CHARACTERS. 
  
 #RM      IFNE   CP#RM,0
  
*         ZERO OUT UNUSED BITS IN LAST WORD OF CARD IMAGE.
*                (CODE STOLEN FROM SCANNER.)
  
          SA2    =XF.IN      (X2) = ADDRESS OF INPUT FILE FIT 
          FETCH  X2,RL,X1    RETURNS RECORD LENGTH (CHARS.) IN X1 
          IX2    X1+X1
          SX3    X1+9 
          SX1    52429       (2**19)/10 + 1 
          IX3    X3*X1
          AX3    19          RECORD LENGTH (WORDS) IN X3
          LX1    X2,B1
          SB6    X3 
          IX2    X2+X1       RECORD LENGTH (BITS) 
          BX4    X3 
          LX3    6
          SA1    =XCP.CARD-1+B6    LAST WORD OF LINE
          LX4    2
          IX3    X3-X4       LINE LINGTH (BITS) 
          MX4    1
          IX3    X3-X2       UNUSED BIT COUNT 
          SB2    X3-59
          AX4    -B2
          BX6    X4*X1       DISCARD UNUSED BITS
          AX4    6
          SA6    A1 
          NZ     X4,FCA2     IF TERMINATOR AT LEAST 12 BITS LONG
          MX7    0
          SA7    A6+B1       TERMINATE LINE WITH 60 ZERO BITS 
 FCA2     BSS    0
 #RM      ENDIF 
          SA3    CP.CARD
          MX0    -2*CHAR
 FCA3     BX4    -X0*X3 
          =A3    A3+1 
          NZ     X4,FCA3     IF NOT END OF IMAGE
          =A5    A3-1 
          SB6    A3 
          BX6    0
          MX7    -1 
          NZ     X5,FCA4     IF NOT FULL WORD END-OF-LINE MARK
          =A4    A5-1 
          MX3    -CHAR
          =B6    B6-1 
          BX5    -X3*X4 
          NZ     X5,FCA5     IF NOT 11-CHARACTER END-OF-LINE
          SX7    1R 
          BX6    X4+X7       CHANGE TO 10-CHAR E-O-L
          SA6    A4 
          EQ     FCA5 
  
 FCA4     IX4    X5+X7       LOCATE TRAILING BIT
          SA3    =40404040404040404040B 
          SA6    B6          MARK END OF IMAGE
          BX7    -X5*X4 
          =B7    60-CHAR+1
          BX4    X3*X7       40B WHERE TRAILING 00B WERE
          LX6    X4,B7
          SA3    =10H 
          IX7    X4-X6
          BX4    X4+X7       77B WHERE TRAILING 00B WERE
          BX6    X4*X3
          IX7    X5+X6       APPEND TRAILING BLANKS 
          SA7    A5 
  
 FCA5     SB7    =XCP.CARD-1
          SX7    B6-B7       (X7) = NR OF WORDS IN SOURCE LINE IMAGE
          SA7    =XL.CARD 
  
          SA1    FV.LGO 
          ZR     X1,FCA6     IF BINARY SUPPRESSED 
          SETFIL FILE=F.LGO,MODE=RESET
  
          IFNE   CP#RM,7,1
          RECALL F.LGO
  
  
 FCA6     RJ     =XTIMER
          SA6    =XTIME1
          EQ     RUN.X       EXIT.. 
 RUN.0    SPACE  4,8
**        FTO - FIRST TIME ONLY CODE. 
* 
*         ACTUALLY PART OF PRIMARY INITIALIZATION. SETS UP FIT/FET, 
*         OPENS FILES, AND OTHER THINGS THAT CANNOT BE DONE BY CODE 
*         WHICH RESIDES IN A BUFFER.
  
  
 FTO      SUBR               ENTRY/EXIT.. 
  
*         INITIALIZE WORKING COPY OF LISTING FLAGS. 
  
          MVE    =XL.MSTR,=XLSTMSTR,=XLSTWRKG 
  
          SX6    =XMIN.TFL
          SA6    =XCP.MXFL   INITIALIZE MAX FL USED 
          SX1    =XFIN       LWA+1 OF (1,0) OVERLAY 
          SA2    LOP=O
          MI     X2,FTO10    IF OBJECT LIST ON
          SX1    =XFIN.OL    TRASH LIST CODE
          SA2    =XLOP=M
          MI     X2,FTO10    IF MAP ON
          SX1    =XFIN.OLR   TRASH LIST AND MAP CODE
 FTO10    SB3    X1 
          SA2    =XRSELECT
          PL     X2,FTO1     IF SHORT OR NO REF MAP 
          SETFIL FILE=F.RMAP,MODE=INIT,FWA=X1 
 FTO1     SA1    FV.LGO 
          SA2    LOP=O
          NZ     X1,FTO1.5   IF BINARY OUTPUT 
          PL     X2,FTO2     IF LONG FILE NOT USED
 FTO1.5   BSS 
          SETFIL FILE=F.LF,MODE=INIT,FWA=B3 
          SA1    FV.LGO 
          ZR     X1,FTO2     IF NO BINARY OUTPUT
          SETFIL FILE=F.LGO,MODE=INIT,FWA=B3
          SB3    B2          FWA OF LGO 
 FTO2     BSS 
          SX6    B3 
          SA6    =XF.TABS    FWA OF TABLES
  
*         OPEN IN AND OUT FILES.  OPEN LGO IF NOT DESELECTED BY 
*         CONTROL CARD OPTION (B=0).
  
          OPEN   F.OUT,NR,RCL 
  
 #RM      IFNE   CP#RM,0
          OPEN   F.IN,,RRCL 
          STORE  X2,MRL=100D
          SA1    FV.LGO 
          ZR     X1,FTO25    IF B=0 SELECTED
          OPEN   F.LGO,,RCL 
  
 #RM      ENDIF 
  
*         IF *REW* PARAMETER IS SELECTED, REWIND INPUT AND LGO FILES. 
 FTO25    SA1    =XCO.REW 
          PL     X1,FTO3     IF *REW* NOT SELECTED
          REWIND F.IN 
          SA1    FV.LGO 
          ZR     X1,FTO3     IF B=0 SELECTED
          REWIND F.LGO
 FTO3     BSS    0
  
 #RM      IFEQ   CP#RM,0
          READ   F.IN        START UP INPUT BUFFER
 #RM      ENDIF 
  
          RJ     IMO         INITIALIZE MAIN OVERLAY
  
          SA2    =XCP.PW
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          NZ     X2,FTO5     IF PW OPTION ON CONTROL CARD 
          SA1    F.OUT+I.DT  PICK UP DEVICE TYPE WORD 
 #OS2     IFEQ   .OS,1       IF OPERATING SYSTEM IS NOS 
          AX1    48          GET DEVICE TYPE FIELD
          SB2    X1-2RTT
          NZ     B2,FTO9     IF NOT A TERMINAL FILE 
          SX2    PW.TTY-1    ADJUST FOR CARRIAGE CONTROL CHARACTER
 #OS2     ELSE
          AX1    54 
          SB2    X1+16B 
          NZ     B2,FTO9     IF NOT A TERMINAL FILE 
          SX2    PW.TTY 
 #OS2     ENDIF 
  
          MX7    0
          SA7    CP.PD       CLEAR OUT PAGE DENSITY CELL
          EQ     FTO6 
  
 #OS      ELSE
          ZR     X2,FTO9     IF NOT *PW* MODE 
 #OS      ENDIF 
  
 FTO5     SX1    X2-126 
          PL     X1,FTO8     IF PW .GE. 126 
 FTO6     SA3    =XCP.LSTF
          BX7    0
          MX0    2*CHAR 
          SA1    =XTL.PNAM+1
          ZR     X3,FTO7     IF L=0 
          SA1    =XO.TTLA-1 
          SA4    =2L1        SET FOR PAGE EJECT 
          =A3    A1+1 
          BX5    -X0*X3 
          BX6    X5+X4
          SA6    A3          ADD CARRIAGE CONTROL TO O.TTLA 
 FTO7     SA7    A1          ADD ZERO TERMINATOR
          SX2    X2+B1       ADD 1 CHARACTER FOR CARRIAGE CONTROL 
          SX0    52429
          SA1    =XTL.PAGE-1 (X1) = ......PAGE   (.=BLANK(55B)) 
          IX3    X2*X0
          AX3    19          (X3) = [PAGE WIDTH/10] 
          SX4    10 
          IX5    X4*X3
          LX1    10*CHAR-4*CHAR 
          IX2    X2-X5       (X2) = REMAINDER AFTER DIVIDE BY 10
          SX4    6
          IX2    X2*X4       (X2) = REMAINDER IN BITS 
          BX7    X1          (X7) = PAGE......   (.=BLANK(55B)) 
          LX2    30 
          BX6    X3+X2
          SA7    A1 
          SA6    A2          CP.PW = 30/CHARACTERS,30/WORDS 
          EQ     FTO9 
  
 FTO8     MX6    0
          SA6    A2          TURN OFF PW MODE 
  
 FTO9     EQ     EXIT.
 IMO      SPACE  4,8
**        IMO -  INITIALIZE MAIN OVERLAY. 
* 
*         ENTRY  TO (1,0) OVERLAY -- SECONDARY INITIALIZATION.
*         EXIT   (1,O) CELLS SET UP.
  
  
 IMO      SUBR               ENTRY/EXIT...
          SA1    =XF.TABS    FWA OF TABLES
          SA2    =XCP.NFLS   CM FIELD LENGTH
          IX6    X2-X1
          SA6    =XW.TABS    WIDTH OF TABLE SPACE 
          AX6    FLSLOP 
          SA6    =XTHRESH    GIVE ALLOC ENOUGH ELBOW ROOM 
          SA1    =XTL.CCOP
          SA2    A1+B1
          BX6    X1          SET C.C. OPTIONS INTO 77-TABLE 
          LX7    X2 
          SA4    =XCP.CPU 
          SA1    =8R CMODEL 
          SX5    BT.IDN9
          SA6    X5+BT.IDNT 
          SA5    CP.PAGE
          PL     X5,IMO2     IF PAGE PROPAGATION
          LX5    1
          PL     X5,IMO1     IF CP.PAGE IS NOT SET
          MX5    2
          EQ     IMO2 
 IMO1     MX5    1
 IMO2     SA7    A6+B1
          BX6    X5 
          SA6    CP.PAGE
  
          SA4    FV.LGO 
          SA1    =XMLOP=O 
          MX6    -1 
          SA2    WIN
          NZ     X4,IMO4     IF BINARY NOT SUPPRESSED (B.NE.0)
          SA6    BINIO       KEEP MANAGER AWAY FROM INTERMEDIATE FILE 
          MI     X1,IMO4     IF OBJECT LIST CHOSEN
          SA2    =XWINX 
 IMO4     BX7    X2 
          SA7    =XWININIT   POSSIBLY MAKE IMMEDIATE RETURN 
  
          SA1    =XMLOP=R 
          SX6    0270B       *JP B7*
          MI     X1,IMO5     IF REF MAP SELECTED
          LX6    48 
          =X7    -1 
          SA6    ERT         WIRE OFF X-REF 
          SA7    REFIO       KEEP MANAGER AWAY FROM REF-TABLE 
  
 IMO5     SA1    =XMLOP=X 
          SA2    ANSI.SW
          PL     X1,IMO6     IF ANSI-LIST OFF 
          LX2    30 
          BX7    X2          ENABLE ANSI LISTING
          SA7    A2 
  
 IMO6     SA1    PLIMIT 
          RJ     CDD         CONVERT DECIMAL (PRINT-LIMIT) TO DISPLAY 
          SB2    B2-10*CHAR 
          AX1    X6,B2       LEFT JUSTIFY 
          SA3    =6LQ2NTRY
          LX1    3*CHAR      4567---123 
          MX0    6*CHAR 
          BX4    -X0*X1      //////-123 
          IX7    X3+X4       Q8NTRY-123 
          BX6    X0*X1       4567-- 
          SA7    PPAD-1 
          =A6    A7+1 
  
  
**        POST REPRIEVE REQUEST.
* 
 .T       IFNE   TEST,0 
          SA1    RA.SSW 
          LX1    59-11
          MI     X1,IMO62    IF SENSE SWITCH 6 ON, SKIP *RPV* REQUEST 
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
          SYSTEM RPV,RCL,=XXJP,37BS6
 #OS      ELSE
          REPRIEVE  =XXJP    POST REPRIEVE REQUEST
 #OS      ENDIF 
 .T       ENDIF 
  
 IMO62    BSS    0
*         IF ROUND IS SELECTED FOR AN OPERATOR, PLUG APPROPRIATE
*         CODE SKELETON ADDRESS IN PSTACK ENTRY FOR THAT OPERATOR.
  
          SA1    =XCO.RND    ROUND CONTROL CARD SETTING 
          ZR     X1,EXIT.    IF NO OPERATIONS TO BE ROUNDED.
          MX2    L.JPAD 
          LX1    1R+
          PL     X1,IMO7     IF + NOT SELECTED
          SA3    =XPSTACK 
          SX4    =XO=RADD 
          BX7    -X2*X3 
          LX4    P.JPAD 
          BX7    X7+X4
          SA7    A3 
 IMO7     LX1    1R--1R+
          PL     X1,IMO8     IF - NOT SELECTED
          SA3    PSTACK+O.MIN-O.PL
          SX4    =XO=RSUB 
          BX7    -X2*X3 
          LX4    P.JPAD 
          BX7    X7+X4
          SA7    A3 
 IMO8     LX1    1R*-1R-
          PL     X1,IMO9     IF * NOT SELECTED
          SA3    PSTACK+O.MULT-O.PL 
          SX4    =XO=RMULT
          BX7    -X2*X3 
          LX4    P.JPAD 
          BX7    X7+X4
          SA7    A3 
 IMO9     LX1    1R/-1R*
          PL     X1,EXIT.    IF / NOT SELECTED
          SA3    PSTACK+O.DIV-O.PL
          SX4    =XO=RDIV 
          BX7    -X2*X3 
          LX4    P.JPAD 
          BX7    X7+X4
          SA7    A3 
  
          EQ     EXIT.
  
*CALL FA=SET
  
 ENDCODE  BSS    0
 LASTLIT  LIT    0LLASTLIT. 
          LIST   L,B,D,R     END OF LISTING 
 BUFFERS  SPACE  4,8
**        BSSX - ASSIGN STORAGE AT END OF PROGRAM 
* 
* SYM     BSSX   LEN
* 
*         *SYM* = SYMBOL TO BE DEFINED. 
*         *LEN* = NUMBER OF WORDS TO RESERVE. 
* 
  
  
          MACRO  BSSX,SYM,LEN 
 A        OCTMIC BSSX.
 B        MICRO  1,8,,SYM       , 
 BSSX     RMT=   ("B" EQU      BSSX+"A"B) 
 BSSX.    SET    BSSX.+LEN
 BSSX     ENDM
  
  
**        EQUX - DEFERRED EQUIVALENCE MACRO 
* 
  
  
          MACRO  EQUX,LOC,VAL 
 B        MICRO  1,8,,LOC       , 
 EQUX     RMT=   ("B" EQU    VAL) 
 EQUX     ENDM
  
  
 OSTACK   BSSX   N.OPSTK     OPERATOR STACK 
 ESTACK   BSSX   N.ELSTK     ELEMENT STACK
 SAVE     BSSX   10          SAVE REGISTERS (PWE) 
 DPTA     BSSX   1           SAVE CELL FOR (X6) 
 ADWT     BSSX   4           TEMPORARY STORAGE FOR TABLE SECTION. 
 CST.BOS  BSSX   1           LOCAL BEGINNING OF STATEMENT 
 DECA     BSSX   7           SAVE / RESTORE REGISTERS FOR *DEC* 
 HOLLSKL  EQUX   OSTACK      SCRATCH AREA FOR BUILDING HOLLERITH CONSTS 
 TRVA     BSSX   2           SAVE OF *X6* AND *X7* IF CR REQUESTED
 AGNK     EQUX   CALLTAG
 CALLTAG  BSSX   1           TAG OF ROUTINE TO BE *CALL*ED (PASS *2*) 
  
*         THESE EQUATES ARE USED BY THE DATA PROCESSOR
  
  
**        TEMP MACRO - USES EQUX REMOTE AREA
* 
  
          MACRO  TEMP,LABEL,LEN 
 A        MICRO  1,8,/LABEL       / 
 EQUX     RMT=   ("A" EQU    "B"+"T"    LEN)
 T        DECMIC "T"+LEN
          ENDM
  
 T        MICRO 
 B        MICRO  1,, OSTACK 
  
 DATEMP   TEMP   0           FWA OF CONTROL CELLS FOR A LIST
 REPFLAG  TEMP   1           REP FLAG 
 CLOSREP  TEMP   1           CLOSE REP FLAG 
 N.ITEM   TEMP   1           NUMBER OF DATA ITEMS 
 PL       TEMP   1           PAREN LEVEL
 I.DIT    TEMP   3           1 - ORDINAL OF NEXT ITEM IN TI.DAT 
                             2 - NUM OF ITEMS REMAINING IN REP LIST 
                             3 - ORDINAL OF 1ST DATA ITEM IN REP LIST 
 DATEMPL  TEMP   0
 TEMP     TEMP   2           SOME TEMPORARIES 
 NONANSI  TEMP   1           FLAG NON-ANSI USAGES 
 DVT      TEMP   2           DVT WORDS - SET BY PDV 
 LPINF    TEMP   3           DO LOOP INDEX INFO 
 BIAS     TEMP   1           ACCUMULATED BIAS DUE TO SUBSC CALC 
 LL       TEMP   1           LOWER LIMIT
 UL       TEMP   1           UPPER LIMIT
 INC      TEMP   1           INCREMENT
 SUBN     TEMP   1           NUMBER OF SUBSCRIPTS IN ARRAY
 SST1     TEMP   0
 CON1     TEMP   MAX.DIM     CON1(I) - CONSTANT MULTIPLIERS 
 INDX     TEMP   MAX.DIM     IVAR(I)
 CON2     TEMP   MAX.DIM     CON2(I) - CONSTANT ADDENDS 
 SIGN     TEMP   MAX.DIM     SIGN(I)
 N.SUBS   TEMP   1           NUMBER OF SUBSCRIPTS 
 N.VSUB   TEMP   1           NUMBER OF VARIABLE SUBSCRIPTS
 SSTL     TEMP   0
 ORGI     TEMP   1           ORG COUNTER INCREMENT
 DA       TEMP   1           ADDRESS DIFFERENCE 
 MP       TEMP   1           MULTIPLIER ( DA*RL ) 
 RL       TEMP   1           NUMBER OF ITEMS IN A REPLIST 
 LI       TEMP   3           TEMPORARIES USED AS LOOP INDICES 
 TMP      TEMP   1           2 TEMPORARIES
 DLEN     TEMP   1
 ORD      TEMP   1           VALUE OF SYMTAB ORDINAL
 SDPF     TEMP   1           0 IF SINGLE PRECISION, 1 IF DOUBLE 
 N.DIMS   TEMP   1           NUMBER OF DIMENSIONS 
 DIM      TEMP   MAX.DIM     DIM1, DIM2, ....,DIM(N)
 DIM.MUL  TEMP   MAX.DIM     1 , DIM1 , DIM1*DIM2 
 SELIST   TEMP   1           ** BEGINNING OF *SB* 
  
*         END OF DATA EQUATES 
  
 EQUA     BSSX   1           TEMP FOR ROOT MEMBER + OFFSET
 FORSKEL  EQUX   OSTACK      SKELETON AREA FOR PACKING FORMAT 
 SCR2     BSSX   MAX.DIM+1   GENERAL SCRATCH AREA 2 
 SCR      BSSX   10          GENERAL SCRATCH AREA. NEVER TO BE USED BY
                             TABLE SECTION. SHOULD BE USED ONLY BY LOCAL
                             ROUTINES.....
 ASFERR   EQUX   SCR+3       ERROR IN PROCESSING *ASF* REFERENCE
 FWAASF   EQUX   SCR+4       FWA OF ASF RELATIVE TO TT.ASF
 FWAREF   EQUX   SCR+5       FWA OF REFERENCE 
 SVB6     EQUX   SCR+6
 SVB5     EQUX   SCR+7
 ASFARG   EQUX   SCR+8       NUMBER OF ARGUMENTS
 FWAARG   EQUX   SCR+9       RELATIVE FWA OF ACTUAL ARGUMENTS 
 CDOTG    EQUX   SCR+6       CURRENT DO TAG BEING PROCESSED 
  
**        BUFFERS AND FIXED LENGTH SCRATCH AREAS. 
  
  
 BSSX     HERE               *BLANK COMMON*, SORT OF
 EQUX     HERE               DEFERRED EQUIVALENCES. 
  
 BUFFERS  EQU    BSSX+BSSX. 
  
 LITBLOC  EQU    LASTLIT-FIRSTLIT+1 
          BSS    BUFFERS-ENDCODE-LITBLOC
 FIN      SPACE  4,4
 FIN.OLR  END                END OF (1,0) WHEN OBJECT LIST + MAP OFF
