ASMB,Q,C
      HED "IGTSM" ROUTINE TO GET A SYMBOL ADDRESS FROM SYSTEM 4-78 (DLB)
      NAM IGTSM,7 09570-16756 REV.2026 800430 
      ENT IGTSM 
      EXT .ENTR,.DFER,EXEC
      SPC 1 
A     EQU 0 
B     EQU 1 
DSCLB EQU 1761B     DISC ADDRESS OF SYSTEM SYMBOL TABLE 
SECT2 EQU 1757B     NUMBER OF SECTORS/TRACK ON LU = 2 
      SPC 1 
* PURPOSE:  THIS ROUTINE WILL SEARCH THE SYSTEM "ENT" 
*   TABLE TO DETERMINE THE INCORE ADDRESS OF THAT SYMBOL. 
* 
* CALLED: 
* 
*     JSB IGTSM 
*     DEF *+3 
*     DEF INAME 
*     DEF IADRS 
* 
* WHERE:
* 
*  INAME = 3 WORD ADDRESS OF THE ASCII SYMBOL NAME
*  A-REG = RETURNED IN-CORE ADDRESS OF THE SYMBOL 
*  IADRS = THE IN-CORE ADDRESS OF THE SYMBOL. 
* 
* ERRORS:  A-REG = 0 IF SYMBOL NOT FOUND
* 
* TEST PROGRAM: 
* 
* FTN,L 
*       PROGRAM TEST
*       DIMENSION NAME(3) 
*       LU = ITMLU(IDMY)
* 1     WRITE (LU,10) 
* 10    FORMAT ("INPUT SYMBOL YOU WANT FIND FROM SYSTEM ENT TABL")
*       READ (LU,11) NAME 
* 11    FORMAT (3A2)
*       IF (IGTSM(NAME,IADDRS).EQ.0) GO TO 1
*       WRITE (LU,12) NAME,IADDRS 
* 12    FORMAT (3A2" IS AT "O6) 
*       END 
*       END$
* 
* NOTE:    INAME MUST BE A TYPE 0 (ADDRESS) ENT.
*          TYPE 1,3 & 4 ARE NOT FOUND IF PRESENT IN TABLE 
*    IADRS MUST = 0 BEFORE CALL 1ST TIME. 
      SPC 1 
INAME NOP           ADDRESS OF SYMBOL NAME
IADRS NOP 
IGTSM NOP           ENTRY 
      JSB .ENTR 
      DEF INAME     GET PARAMETER ADDRESSES 
      LDA IADRS,I   CHECK IF SYMBOL HAS 
      SZA           ALREADY BEEN FOUND? 
      JMP IGTS3     YES, SKIP DISC SEARCH 
      JSB .DFER     GET THE NAME OF SYMBOL LOCALLY
      DEF NAME+0
      DEF INAME,I 
      LDA NAME+2
      AND OM400     MASK OFF LAST CHAR
      STA NAME+2    AND SAVE
      LDB DSCLB     CALCULATE STARTING TRACK NUMBER 
      LSR 7 
      STB TRACK     SAVE STARTING TRACK NUMBER
      LDA DSCLB     GET THE STARTING TRACK/SECTOR OF ENT TABLE
      AND O177      MASK OFF THE TRACK NUMBER 
      RAR,CLE,ELA  *781011 PUT LEAST BIT IN E-REG.
      CLB,SEZ      *781011 SET OR CLEAR FLAG PER E-REG VALUE
      CCB          *781011
      STB INAME    *781011 SAVE INTO 1ST TIME FLAG WORD 
IGTS1 CPA SECT2     CHECK IF AT END OF TRACK? 
      CLA,RSS       YES SET TO ZERO 
      RSS           SKIP BUMPING TRACK NUMBER 
      ISZ TRACK     BUMP TRACK NUMBER 
      STA SECTR     SET CURRENT READING SECTOR
      JSB EXEC      GO READ THE NEXT DISC BUFFER
      DEF *+7 
      DEF O1        READ
      DEF O2        LOGICAL UNIT TWO
IBUFF DEF IBUF      BUFFER = 128 WORDS
      DEF D128      LENGTH IN WORDS 
      DEF TRACK     TRACK NUMBER
      DEF SECTR     SECTOR NUMBER 
      LDB IBUFF     GET BUFFER ADDRESS
      ISZ INAME    *781011 CHECK IF 1ST TIME FLAG IS SET? 
      RSS          *781011 NO, USE WHOLE DISC READ BUFFER 
      ADB D64      *781011 YES, USE ONLY SECOND HALF OF DISC READ BUFFER
IGTS2 LDA B,I       GET THE 1ST WORD
      CPA NAME+0    DO 1ST CHARS MATCH? 
      INB,RSS       YES, CHECK 3RD AND 4TH
      JMP IGTS4     NO TRY NEXT ENTRY 
      LDA B,I       GET CHARS 3 & 4 
      CPA NAME+1    MATCH?
      INB,RSS       YES, TRY LAST CHARACTER 
      JMP IGTS5     NO TRY NEXT ENTRY 
      LDA B,I       GET LAST ENTRY & TYPE 
      CPA NAME+2    MATCH?
      CLE,INB,RSS   YES, FOUND, GET THE ADDRESS 
      JMP IGTS6     NO
      LDA B,I       GET THE ADDRESS 
      STA IADRS,I   AND PASS BACK TO CALLER 
IGTS3 JMP IGTSM,I   AND EXIT A-REG = SAME 
      SPC 1 
IGTS4 INB           BUMP TO TYPE OF ENTRY 
IGTS5 INB           BUMP TO TYPE OF ENTRY 
      LDA B,I       GET ENTRY TYPE CODE 
IGTS6 AND O177      NO, CHECK IF END OF LIST? 
      CMA,INA       TYPE ONE ENTRY TERMINATES LIST
      INA,SZA,RSS   CHECK IF TYPE ONE ENTRY?
      JMP IGTS3     SORRY NOT FOUND 
      ADB O2        BUMP TO NEXT ENTRY
      LDA SECTR     GET THE NEXT READ SECTOR
      ADA O2        BUMP TO NEXT BLOCK
      CPB LAST1     CHECK IF LAST ONE?
      JMP IGTS1     YES, GO READ NEXT DISC BUFFER 
      JMP IGTS2     NO, TRY NEXT ENTRY
      SPC 1 
TRACK NOP           CURRENT TRACK NUMBER
SECTR NOP           CURRENT SECTOR NUMBER 
O1    OCT 1 
O2    OCT 2 
O177  OCT 177 
D64   DEC 64
OM400 OCT -400
NAME  BSS 3         NAME TO SEARCH FOR
D128  DEC 128       BUFFER LENGTH 
IBUF  BSS 128 
LAST1 DEF *         LAST + 1 WORD ADDRESS OF BUFFER 
      ORR 
      END 
                                                                                                                                    