*                 CATALOG NO. 704742 - SIGMA 5/7 BPM M:TELESCPE
       CSECT       1
         SYSTEM   SIG7FDP
*
*
*        TELESCOPE--PACKS LOAD CONTROL COMMAND TABLE, TREE TABLE,
*                 AND ROM TABLE INTO ONE TABLE
*
*
         TITLE    'TELESCOPE ROUTINE'
       PAGE
*                 SYMBOLIC REGISTER DEF'S.
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
*                 CHANGE STACK POINTER AMOUNT SPEC. BY 1ST ARGUMENT.
*                 SECOND ARGUMENT SPEC. AVAILABLE REGISTER.
BUMP     CNAME
         PROC
LF       LI,AF(2) AF(1)
         MSP,AF(2)  TSTACK
         PEND
*                 PUSH OR PULL N WORDS SPECIFIED BY 1ST ARGUMENT INTO
*                 REG'S STARTING AT 2ND ARGUMENT.
PUSH     CNAME    X'9',X'B'
PULL     CNAME    X'8',X'A'
         PROC
         DO       NUM(AF)=1
LF       GEN,1,7,4,3,17 0,NAME(1),AF(1),0,TSTACK
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17  0,NAME(1),AF(2),0,TSTACK
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17  0,NAME(2),AF(2),0,TSTACK
         FIN
         FIN
         PEND
         REF      TSTACK
         PAGE
K0       EQU      X'0'
K1       EQU      X'1'
K2       EQU      X'2'
K3       EQU      X'3'
K6       EQU      X'6'
K7       EQU      X'7'
KA       EQU      X'A'
KF       EQU      X'F'
K10      EQU      X'10'
K11      EQU      X'11'
K12      EQU      X'12'
K13      EQU      X'13'
K15      EQU      X'15'
K35      EQU      X'35'
K55      EQU      X'55'
K75      EQU      X'75'
K85      EQU      X'85'
K100     EQU      X'100'
KN1      EQU      -X'1'
KN2      EQU      -X'2'
KN3      EQU      -X'3'
KN8      EQU      -X'8'
KN10     EQU      -X'10'
KN11     EQU      -X'11'
ROMTAD   EQU      ROMTADR
TREEAD   EQU      TREETADR
READCT   EQU      K12
WRITECT  EQU      K13
UNSATCT  EQU      K11
EXECCT   EQU      KA
READAC   EQU      K15
WRITEAC  EQU      K35
UNSATAC  EQU      K55
EXECAC   EQU      K75
EXECVE   EQU      K85
ROMTNM   EQU      KN8
TROMLK   EQU      K6
RROMLK   EQU      KF
TREENTRY EQU      TTESIZE
ROMENTRY EQU      K7
CHARB    EQU      X'C2'
CHARG    EQU      X'C7'
LOCCT    EQU      K0
KSTAR    EQU      X'5C'
         PAGE
         REF      SYSID
         REF      XFFFF
         REF      Y03
       REF     Y09
         REF      Y08
         REF      Y0C
         REF      Y1
         REF      ACCN
         REF      CJOB
         REF      ROMTADR
         REF      TREETADR
         REF      ALOCCT
         REF      X1FFFF
         REF      TTESIZE
         REF      X1FF
         REF      NOPGERR
         REF,1    JB:TDP
         REF      BLANK
         DEF      TELESCPE
         SPACE    3
         PAGE
TELESCPE EQU      %                 TELESCOPE LOCCT (READ ACCTS, WRITE
         PUSH     7,R5
         LW,R6    ALOCCT,R5         (R6) = ADDRESS OF LOCCT
         AND,R6   X1FFFF
READCT2  EQU      9
         INT,D1   READCT2,R6        D2 = SIZE OF WRITE ACCT STRG
         SAD,D1   1                 D1 = SIZE OF READ ACCT STRG
         AW,D1    R6
         AI,D1    READAC
         LW,D3    R6
         AI,D3    WRITEAC           (D3) = OLD ADDR OF WRITE ACCTS
         BAL,R3   TBLSHFT           SHIFT WRITE ACCTS
         AW,D1    R1                (D1) = LAST WRITE ACCT LOC +1,
         LI,R3    UNSATCT           EQU NEW ADDR OF UNSAT ACCTS
         LH,D2    *R6,R3
         BEZ      TELE1             BRANCH IF NO UNSAT ACCTS
         SAS,D2   2                 (D2) = SIZE OF UNSAT ACT STG
         AI,D3    UNSATAC-WRITEAC   OLD ADDR OF UNSAT ACCTS
         BAL,R3   TBLSHFT           SHIFT UNSAT ACCTS
         AW,D1    R1                (D1) = LAST UNSAT ACCT LOC +1,
TELE1    EQU      %
         LI,R3    EXECCT            EQU NEW ADDR OF EXECUTE ACCTS
         LH,D2    *R6,R3
         SAS,D2   1
         AI,D3    EXECAC-UNSATAC    OLD ADDR OF EXECUTE ACCTS
         BAL,R3   TBLSHFT           SHIFT EXECUTE ACCTS
         AW,D1    R1                (D1) = LAST EXECUTE ACCT LOC +1
         LI,R3    EXECVE            EQU NEW ADDR OF EXECUTE VEHICLE
         LW,D2    *R6
         CW,D2    Y1
         BAZ      TELE1A            BRANCH IF NO EXECUTE VEHICLE
         LI,D2    3
         AI,D3    EXECVE-EXECAC     OLD ADDR OF EXECUTE VEHICLE
         BAL,R3   TBLSHFT
         AW,D1    R1                (D1) = LAST VEHICLE LOCATION +1
TELE1A   EQU      %                 EQU NEW ADDR OF TREE TABLE
         LW,D3    TREEAD,R6         FIRST LOC IN TREE TBLE -1 (TREE SZE)
         LW,R0    *D3               (R0) = NO. OF WORDS IN TREE TABLE
         LI,D2    K1                (D2) = NO. OF WORDS TO BE SHIFTED
         BAL,R3   TBLSHFT           SHIFT TREE SIZE WORD
         LI,D4    K0
TELE2    EQU      %
         LI,D2    TREENTRY          (D2) = NO. OF WORDS TO BE SHIFTED
         BAL,R3   TBLSHFT1          SHIFT TREE TABLE ENTRY
         AI,D4    K1                (D4) =CNT OF NO. OF TREE TBL ENTRIES
         CW,R1    R0                (R1) =NO. OF WORDS ALREADY SHIFTED
         BL       TELE2             BRANCH TO SHIFT NEXT TREE TBLE ENTRY
         AI,D1    K1                TREE SIZE NOT INCL IN TREE TABLE
         STW,D1   TREEAD,R6         STORE TRUE TREE BASE IN LOCCT
         LI,R3    K0
         B        TELE3
TBLSHFT  EQU      %                 ENTER W/ SOURCE ADDR IN D3, DEST
         LI,R1    K0                       ADDR IN D1, COUNT IN D2
TBLSHFT1 EQU      %
         LW,R2    *D3,R1
         STW,R2   *D1,R1
         AI,R1    K1
         BDR,D2   TBLSHFT1
         B        0,R3
*STARNAME CONSTRUCTS MONITOR ASSIGNED MODULE NAME, STORES NAME, JOB ACCN
*ZEROED PASSWORD STARTING AT SPECIFIED LOCATION. ENTER WITH DESTINATION
*ADDR IN R4, JIT ADDR IN R5, RETURN ADDR IN SR4 AND APPROPRIATE
*ALPHANUMERIC CHARACTER IN LOW ORDER BYTE OF D2. UPON EXIT D2 CONTAINS
*ERROR CODE IF NO PAGE, ZERO IF PAGE GOTTEN.
STARNAME EQU      %                 STORE MONITOR ASSIGNED NAME AND JOB
         LW,R2    R4                CHECK FOR ROMT OVERFLOW
         AND,R2   X1FF              ARE WE OUT OF COMMON?
         BCS,2    STARNM0           NO
         LI,R2    1                 YES, GET ANOTHER PAGE
         OR,R2    Y0C
         CAL1,8   2
         BCR,8    STARNM0           DID WE GET ONE?
         LI,D2    NOPGERR           NO, SET FLAG
         B        *SR4
STARNM0  EQU      %
         LW,R2    SYSID,R5
         AND,R2   XFFFF             (R2) = CUR SYSTEM ID
         SLS,R2   8
         AW,R2    Y03
         AW,R2    D2                (R2) = FILE NAME SYSIDX
         LW,R3    BLANK
         AI,R4    ROMTNM
         STW,R2   0,R4              STORE FILE NAME IN 1ST WORD
         STW,R3   1,R4              BLANKS IN WORD 2
         STW,R3   2,R4              BLANKS IN WORD 3
STARNM1  EQU      %                 JOB ACCN, ZEROED PSWD STORED AT (R4)
         LM,R1    ACCN,R5           STORE JOB ACCT #
         STM,R1   3,R4                IN ACCT # LOC
         LI,R1    0                 STORE
         STW,R1   5,R4               NO
STARNM2  EQU      %
         STW,R1   6,R4                PASSWORD
         LI,D2    0                 RESET FLAG
         B        *SR4
         SPACE    2
TELE3    EQU      %
         MTB,-1   *D1               DECREMENT BYTE CNT OF EACH SEG NAME
         AI,D1    TREENTRY          (D1) = ADDR OF NEXT TREE ENTRY
         AI,R3    K1                (R3) = NO. OF ENTRIES WITH BYTE CNT
         CW,R3    D4                       ALREADY DECREMENTED
         BNE      TELE3             BRANDH TO DECREMENT NXT NAME BYTECNT
         LW,D3    ROMTAD,R6
         AND,D3   X1FFFF            (D3) = ADDR OF ORIGINAL ROM TABLE
         LW,R4    D3
*                                   *IDG FORMED AT ROMTB-8
         LI,D2    CHARG
         BAL,SR4  STARNAME          ROM ENTRY FOR ELEMENTS ON GO MEDIUM
         CI,D2    0                 WAS COMMON GOTTEN IF NEEDED?
         BNE      TELE9A            NO
*                                   *IDB FORMED AT ROMTB-16
         LI,D2    CHARB
         BAL,SR4  STARNAME          ROM ENTRY FOR ELEMENTS ON BI MEDIUM
         CI,D2    0                 WAS COMMON GOTTEN IF NEEDED?
         BNE      TELE9A            NO
         LW,R1    D4                (R1)= NO. OF TREE TABLE ENTRIES
         LW,D4    LOCCT,R6
         SLS,D4   20                (D4) = BI, GO MEDIUM & OVERLAY FLAGS
         LW,R0    ROMTAD,R6            IN BITS 0-2 & ROM TABLE SIZE
         PUSH     R0
         SLS,R0   KN1                  IN BITS 16-31
         AH,D4    R0
         STW,D1   ROMTAD,R6         (D1) = ADDR OF NEW ROM TABLE
TELE4    EQU      %
         LW,D2    TREEAD,R6         (D2) = ADDR OF TREE TABLE
         LI,R2    K0                ZERO INDEX TO NEW ROMT
         LI,R3    K0                ZERO INDEX TO ORIG ROMT
         LC       D4
         BCR,2    TELE8A
TELE5    EQU      %
         LI,R4    TROMLK            (R4) = POINTER TO ROM LINK IN TREE
         LH,R3    *D2,R4
         AI,R3    -1
         STH,R2   *D2,R4            NEW ROM LINK REPLACES ORIGINAL LINK
TELE6    EQU      %                        FROM OLD ROMT
         ANLZ,R5  TELE6B            CHECK LOCCT OVFLOW ON NEW ROMT ENTRY
         AI,R5    7
         LI,R6    JB:TDP            CHECK IF MORE CORE NEEDED
         LB,R6    0,R6
         SLS,R6   9                 TO PAGES
         CW,R5    R6                WILL NEXT ROMT ENTRY OVERFLOW PAGE
         BL       TELE6A            NO
         LI,R5    1                 YES, GET ANOTHER PAGE
         OR,R5    Y08
         CAL1,8   5
         BCR,8    TELE6A
         LI,D2    NOPGERR           DIDNT GET ONE
         PULL     R6
         B        TELE9
TELE6A   EQU      %
         LCI      ROMENTRY
         LM,R5    *D3,R3            ONE ROM IS ADDED TO NEW ROMT EACH
TELE6B   EQU      %
         STM,R5   *D1,R2                   PASS THROUGH THE LOOP
         AI,R2    ROMENTRY          INDEX TO NEXT ROM IN NEW ROMT
         LC       D4
         BCR,2    TELE8             BRANCH IF NO OVERLAY STRUCTURE
         LI,R4    RROMLK            (R4) = POINTER TO ROM LINK IN ORIG
         LW,R0    D3                       ROMT
         AW,R0    R3
         LH,R3    *R0,R4            (R3) =INDEX TO NEXT ROM IN ORIG ROMT
         BEZ      BIFLG             BRANCH IF LAST ROM IN SEGMENT
         AI,R3    -1
         B        TELE6
BIFLG    EQU      %
         LC       D4
         BCR,8    GOFLG             BRANCH IF NO BI ROM TO BE CONSTRUCTD
         SLS,D4   K1
         SLS,D4   KN1               ZERO BI FLAG
         LW,R0    D3
         AI,R0    KN10
         STH,R3   *R0,R4            ZERO INDEX TO NEXT ROM IN SEGMENT
         LI,R3    KN10
         B        TELE6             SHIFT BI ROM
GOFLG    EQU      %
         BCR,4    TELE7             BRANCH IF NO GO ROM TO BE CONSTRUCTD
         SLS,D4   K2
         SLS,D4   KN2               ZERO GO MEDIUM FLAG
         LW,R0    D3
         AI,R0    ROMTNM
         STH,R3   *R0,R4            ZERO INDEX TO NEXT ROM IN SEGMENT
         LI,R3    ROMTNM
         B        TELE6             SHIFT GO MEDIUM ROM
TELE7    EQU      %
         LW,R0    D1
         AW,R0    R2
         LI,R4    KN11              ZERO LAST NAME BYTE, INDICATING LAST
         STB,R3   *R0,R4                   ROM IN SEGMENT TO LOADER
         AI,D2    TREENTRY          (D2) = ADDR OF NEXT TREE ENTRY
         BDR,R1   TELE5             BRANCH IF TREE ENTRY COUNTER NOT =0
         B        TELE9             TABLES COMPLETED
TELE8    EQU      %                 NO OVERLAY, STORE ROMS SEQUENTIALLY
         AI,R3    ROMENTRY
         AI,R3    K1                (R3) =INDEX TO NEXT ROM IN ORIG TBLE
TELE8A   EQU      %
         LI,R4    K1
         MTH,-8   D4,R4             (D4,BITS 16-31) = ROMT SIZE
         BGEZ     TELE6
         LI,R1    K0                WILL EXECUTE OVERLAY CODE, SET TREE
         LI,R3    K0                COUNTER =0. (R3)=DATA TO SET LINKS
         LI,R4    RROMLK
         B        TELE7
TELE9    EQU      %
         PULL     R6
         LI,D2    0                 SET D2=0 FOR NORMAL RETURN
TELE9A   EQU      %
         PULL     7,R5
         B        *SR4              END OF TELESCPE ROUTINE
         END

