ASMB,Q,C
      HED ** 16K FTN4 COMPILER (F4/3:SYMBOL TABLE/XREF) **
      NAM F4.3,5 92060-16097 781212 REV. 1913 
* 
*************************************** 
*     FORTRAN-4 COMPILER OVERLAY 3
*************************************** 
* 
*     THIS OVERLAY GENERATES THE SYMBOL TABLE LIST AND CROSS REFERENCE
*   LISTING FROM THE CREF INFO IN THE INTER PASS FILE 
* 
* 
* 
* 
* 
* 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
* 
* 
* 
* 
* 
*     EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS 
* 
*     THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS 
*     DEFINED IN AS FOLLOWS 
*                2 -- OA.F  (WRITE PASS FILE ROUTINES)
*                 3 -- NEX.F  (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) 
*                  4  -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) 
*                   5  -- EX.F  (STATEMEXTS USING THE EXPRESSION EVALUATOR) 
*                    6  -- IC.F  (THE CHARACTER INPUT ROUTINES) 
*                     7  -- IDN.F   (THE TOKEN INPUT ROUTINES)
*                      8  -- FTN4    ( THE MAIN)
       EXT F..DP    BASE OF SYMBOL TABLE
   EXT     F.A      ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY)
     EXT   F.ABT    ABORT COMPILE EXTRY 
   EXT     F.AF     ADDRESS FIELD CURREXT F.A 
   EXT     F.AT     ADDRESS TYPE OF CURREXT F.A 
       EXT F.CCW    FTN OPTION WORD 
   EXT     F.DNI    ADDRESS OF NID
       EXT F.DO     LWAM - END OF DO TABLE
       EXT F.EMA    F.A OF EMA EXT ENTRY, WINDOW SIZE 
   EXT     F.IM     CURREXT ITEM MODE (REAL, COMPLEX,ECT.)
   EXT     F.IU     CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) 
       EXT F.LO     END OF ASSIGNMEXT TABLE+1 
     EXT   F.LOP    NO. LINES LEFT ON THIS PAGE.
   EXT     F.ND     NUMBER OF DIMENSIONS
   EXT     F.NW     NO. WORDS THIS TABLE F.A EXTRY. 
   EXT     F.S2B    BOTTOM OF STACK 2 
       EXT F.SEG    LOAD A NEW SEGMENT
* 
*     EXT'S WITH A TRAILING '.F' ARE SUBROUTINES
* 
     EXT   ASC.F    CONVERT TO 4 ASCII DIGITS 
     EXT   EJP.F    PAGE EJECT SUBROUTINE 
   EXT     FA.F     FETCH ASSIGNS 
   EXT     FID.F    FETCH (ID) TO NID (UNPACK)
   EXT     GNA.F    GET NEXT SYMBOL TABLE EXTRY 
     EXT   PSL.F    PRINT LINE ON PRINTER 
     EXT   SKL.F    SKIP LINES ON LIST
* 
* 
* 
*     UTILITY LIBRARY ROUTINES
* 
      EXT .MVW
      EXT IFBRK     BREAK CHECK ROUTINE 
* 
*     OPSYSTEM INTERFACE: 
      EXT RWN.C     REWIND FILE ROUTINE 
      EXT RED.C     READ FILE ROUTINE 
      EXT C.SC1     SCRATCH FCB 
* 
*     COMPILER LIBRARY
* 
      EXT GMS.C     GET MAIN MEMORY BOUNDS
      SPC 1 
      SUP 
A     EQU 0 
B     EQU 1 
      SPC 1 
      DEC 3         OVERLAY # 
      SKP 
*     ****************************************
*     * SYMBOL FROM ASS. TBL. TO LIST BUFFER *
*     ****************************************
* 
STOL  NOP           B IF ASS. TBL. ADDRESS
      LDA B,I       GET COUNT 
      AND K7
      ADA B         A IS ADDRESS OF LAST CHAR+1 
      STA STP       SET AS STOP 
      ADB K2        B IS ADDRESS OF FIRST CHARS.
      LDA STOL,I    P+1 IS ADDRESS OF WHERE TO PUT IT 
      STA ASSLC     SET IT
      ISZ STOL      STEP TO RETURN ADDRESS
      JSB STMV      MOVE THE SYMBOL 
      JMP STOL,I    RETURN
* 
* 
STMV  NOP           SYMBOL MOVE  B=ADDRESS,STP= STOP ADDRESS
STOL1 CPB STP       DONE? 
      JMP STMV,I    YES EXIT
* 
      LDA B,I       GET FIRST TWO CHAR. 
      ALF,ALF       ROTATE TO 
      JSB PUT.F     PUT FIRST OUT FIRST 
      LDA B,I       GET NEXT
      AND B177      ISOLATE 
      CPA B40       IF BLANK
      JMP STMV,I    QUIT  NO BLANKS ALLOWED 
* 
      JSB PUT.F     ELSE PUT IT OUT 
      INB           STEP B
      JMP STOL1     GO GET NEXT CHAR. 
* 
STP   NOP 
B177  OCT 177 
B100  OCT 100 
      SKP 
F4.3  BSS 0         BEGIN HERE! 
      LDA F.CCW     PRINT TABLE IF T OPTION SET.
      AND K8
      SZA,RSS 
      JMP XREF      NO, JUST XREF 
* 
      JSB EJP.F 
OLOOP LDA F..DP     (OUTER LOOP)
      STA F.A       START OF SYMBOL TABLE 
      STA SAV.A     SAVE AS A FLAG. 
LOOPI JSB GNA.F     GET NEXT SYMBOL TABLE ENTRY.
      SSA,RSS       IF TOP OF S.T. REACHED, 
      JMP LOOPE     END OF LOOP THRU ASSIGN. TABLE
      LDA F.A,I 
      SSA           IF ITEM IS MARKED OUT, A CONSTANT 
      JMP LOOPI     OR DIM. INFO., SKIP IT. 
      JSB FID.F     OTHERWISE, GET SYMBOL ID, TAGS. 
      JSB FA.F
      LDA F.NW      NUMBER OF WORDS FOR ENTRY.
      CPA K2        IF TWO, 
      JMP LOOP      GET NEXT ENTRY. 
      CPA K1        IF ONE, 
      JMP LOOP      GET NEXT ENTRY. 
      LDA F.A 
      ADA K2
      LDA A,I       IF THIS IS A TEMP CELL ENTRY
      SSA 
      JMP LOOP      SKIP IT.
      LDB F.DNI 
      STB T.DNI 
      LDA B,I       FIRST CHAR "@" ?
      CPA B100
      JMP LOP6A     YES. STATEMENT #
      LDA F.IU
      SZA,RSS       IF F.IU = 0, SKIP THIS ITEM 
      JMP LOOP
      LDB F.AF
      CPA B200      IF F.IU = SUBROUTINE, 
      SZB           OR ADDR FIELD # 0,
      JMP LOOP0     PROCESS ITEM
      LDA F.AT
      CPA DUM       OTHERWISE, IF IT IS DUMMY 
      JMP LOOP0     PROCESS ITEM
LOOP  LDA F.A,I      SET NAME TAG OF ITEM TO 1
      IOR KK01      TO MARK IT OFF. IT WON'T BE 
      STA F.A,I      LOOKED AT AGAIN. 
      JMP LOOPI     CONTINUE TO LOOK FOR PRINT ITEM.
      SPC 1 
LOP6A LDA F.AT      IF F.AT = 2000, UNDEFINED STMT #. 
      CPA B2000 
      JMP LOOP      SKIP IT 
LOOP0 LDA SAV.A     IF THIS IS FIRST PRINTABLE
      CPA F..DP     TIME FOUND IN A LOOP THRU A.T., 
      JMP LOOPR     THEN SET UP AS AN INITIAL SYMBOL
      LDB BSNID 
LOOPD LDA B,I       CHARACTER FROM SNID 
      CMA,INA 
      ADA T.DNI,I   CHARACTER FROM NID
      SZA,RSS       IF 0, 
      JMP LOOPF     SAME CHAR, CHECK NEXT ONE.
      SSA,RSS 
      JMP LOOPI     POSITIVE, CURRENT LARGER. 
LOOPR LDA F.A       FOR COMPARISON. 
      STA SAV.A 
      LDA F.DNI     THIS IS ALPHABETICALLY THE
      LDB BSNID     LOWEST NAME YET 
      JSB .MVW      .MVW TO SAVE AREA 
      DEF K6
      NOP 
      JMP LOOPI 
      SPC 1 
LOOPF INB           COMPARE NEXT
      ISZ T.DNI     CHARACTER 
      JMP LOOPD 
* 
LOOPE LDA SAV.A     IF NO ITEM FOUND FOR
      CPA F..DP     PRINTING IN THIS LOOP 
      JMP XREF      DONE. TEST TO SEE IF XREF REQUESTED 
      STA F.A       SET F.A TO SAV.A
      JSB FID.F     GET SYMBOL ID, TAGS FOR PRINT 
      JSB FA.F
      LDA F.LOP     PRINT A SYMBOL TABLE LINE.
      INA,SZA,RSS   AT BOTTOM OF PAGE?
      JSB EJP.F     YES. FORMFEED 
      LDA F.LOP 
      SZA           AT TOP OF PAGE? 
      JMP LOOP5     NO. 
      LDA K7.       YES; PRINT HEADER 
      LDB LABLE     AND TWO BLANK LINES 
      JSB PSL.F     THEN "SYMBOL TABLE" 
      CLA 
      JSB SKL.F     THEN A BLANK LINE 
      LDA K31 
      LDB HEADR 
      JSB PSL.F     THEN HEADER 
      CLA,INA 
      JSB SKL.F     AND TWO MORE BLANK LINES. 
LOOP5 JSB CLR1      CLEAR OUT LIST BUFFER 
      SPC 1 
*         TRANSFER NAME TO LINE.
      SPC 1 
      LDB F.A 
      JSB STOL
      DBL LBUF+1
      SPC 1 
*         TRANSFER ADDRESS TO LINE. 
      SPC 1 
      LDB F.AF      GET ADDRESS 
      LDA F.AT      CHECK IF LABELED COMMON 
      CPA BCOM      IF SO 
      RSS           SKIP TO DO IT 
      JMP ATL1      ELSE JMP
* 
      LDA F.IU      CHECK IF ARRAY
      CPA ARR       IF SO 
      RSS           SKIP
      JMP ATL0      NOT ARRAY 
* 
      LDB F.A       ARRAY  CHECK
      INB           THE DIM ENTRY 
      LDB B,I       TO SEE IF IT WAS
      LDA B,I         (GET FIRST WORD OF DIM ENTRY) 
      ADB K2        REFERENCED
      LDB B,I       B HAS F.AF IT ARRAY TABLE WAS BUILT 
      AND K8        ISOLATE REFERENCE BIT 
      SZA           IF TABLE BUILT
      STB F.AF      RESET F.AF TO RIGHT VALUE 
      LDB F.AF      SET B TO THE PROPER F.AF IF NOT REFERENCED
ATL0  LDA F.AF,I    CHECK SIZE TO SEE 
      AND K7        IF IT IS AN EMA 
      CPA K4        INFO ENTRY
      JMP EMAAD     IT IS GO FORMAT EMA 
      CPA K5        EMA DUMMY ? 
      JMP EMAFP     YES.
* 
      INB           STEP TO AND 
      LDB B,I       GET THE OFFSET
ATL1  SSB 
      CMB,INB 
      LDA ADDR2     ADDRESS FIELD OF LINE.
      STA ASSLC     SET LOCATION
      JSB ASCI5     CONVERT TO ASCII AND STORE. 
      SPC 1 
*         RELOCATION INDICATOR TO LINE
      SPC 1 
      LDA "R"       ASSUME PROGRAM RELOCATABLE. 
      LDB F.AT
      CPB COM.      IF COMMON,
      LDA "C"       SET INDICATOR TO 'C'. 
      CPB BCOM      IF BCOM 
EMART LDA B53       USE "+"   (RETURN FROM EMAAD) 
      LDB F.IU
      CPB SUB 
      RSS 
      JMP LOOP1     NOT A SUBPROGRAM
* 
      LDB F.AF
      SSB 
      LDA "X"       EXTERNAL SUBPROGRAM.
LOOP1 STA USE       SAVE USE FOR LATER
      JSB PUT.F     PUT THE CHAR IN THE LINE
      SPC 1 
*         TYPE TO LINE
      SPC 1 
      LDA IU1       ITEM USAGE = STATEMENT NUMBER?
      LDB SNID
      CPB B100
      JMP LOOP3     YES, SKIP TYPE AND LOCATION.
* 
      LDA IM1 
      LDB F.IM
      CPB CPX 
      LDA IM2 
      CPB INT 
      LDA IM3 
      CPB LOG 
      LDA IM4 
      CPB REA 
      LDA IM5 
      LDB TYPE      TYPE FIELD OF LINE
      JSB .MVW
      DEF K4
      NOP 
      SPC 1 
*         LOCATION TO LINE
      SPC 1 
      LDA LO4       ASSUME 'LOCAL'
      LDB USE 
      CPB "X"       IF EXTERNAL INDICATOR,
      LDA LO1       CHANGE TO 'EXTERNAL'
      LDB F.AT
      CPB COM.      IF COMMON,
      LDA LO2       CHANGE TO 'COMMON'
      CPB DUM       IF DUMMY, 
      LDA LO3       CHANGE TO 'DUMMY'.
      CPB BCOM      IF LABELED COMMON 
      LDA LO5       CHANGE TO 'L COMMON'
      LDB LOCAT     LOCATION FIELD OF LINE
      JSB .MVW
      DEF K4
      NOP 
      ISZ EMFLG     EMA DUMMY ? 
      JMP USAG1     NO. 
      DLD LO6A      YES, COPY "(EMA)" 
      DST LBUF+30 
      LDA LO6A+2
      STA LBUF+32 
      SPC 1 
*         USAGE TO LINE 
      SPC 1 
USAG1 LDB F.IU
      CPB SUB 
      RSS 
      JMP LOOP2     NOT SUBPROGRAM
* 
      LDA IU2       ASSUME STATEMENT FUNCTION 
      LDB USE 
      CPB "X"       IF EXTERNAL 
      LDA IU3       CHANGE TO SUBPROGRAM. 
      LDB F.AT
      CPB DUM       OR IF DUMMY,
      LDA IU3       CHANGE TO SUBPROGRAM. 
      CPB BCOMI     IF BCOM INFO ENTRY
      LDA IU8       CHANGE TO BCOM LABEL
      JMP LOOP3 
      SPC 1 
EMAAD LDA F.AF,I    FORMAT AN EMA ADDRESS TO THE LINE 
      AND B20       CHECK IF WORDS REARRANGED YET 
      CMA,CLE,INA   SET E IF NOT
      LDB F.AF      GET ADDRESS OF INFO TABLE 
      LDA B,I       SET FLAG TO SHOW
      IOR B20       THEY ARE
      STA B,I       REARRANGED NOW
      INB           SET ADDRESS OF THE FIRST TWO WORDS
      STB DAD2
      DLD B,I       GET THE WORDS 
      SEZ           IF OK 
      SWP           THEN SKIP SWAP
      DST DAD2,I    SET THE RESULT BACK 
DAD2  EQU *-1 
* 
      ISZ DAD2      STEP TO THE ADDRESS WORDS 
      DLD DAD2,I    GET THEM
      CLE,ERB       FORMAT A DOUBLE INTEGER 
      RAL,ERA 
      ASL 6         SET PAGE NUMBER IN B
      LDA ADDR      SET THE ADDRESS 
      STA ASSLC     FOR THE ADDRESS 
      JSB ASCI4     THEN TO THE LINE
      LDA "P"       NOW SEND THE 'P' TO INDICATE PAGE 
      JSB PUT.F     TO THE LINE 
      LDA B40       AND A BLANK 
      JSB PUT.F 
      LDA DAD2,I    GET THE OFFSET
      AND B1777     ISOLATE THE OFFSET
      STA B         AND 
      JSB ASCI4     SEND IT TO THE LINE 
      JMP EMART     GO SEND THE '+' 
* 
ASCI4 NOP           ROUTINE TO CONVERT 4 OCTAL DIGITS FROM B
      LDA KM4       TO THE OUT PUT LINE 
      BLF,RBL       POSITION FIRST DIGIT IN 
      RBL,RBL       LEAST 3 BITS OF B 
      JSB NUM.F     CONVERT IT TO THE LINE
      JMP ASCI4,I   RETURN
* 
EMAFP LDA DUM       EMA DUMMY.  SET F.AT=DUM
      STA F.AT
      CCA           SET EMA FLAG. 
      STA EMFLG 
      LDB F.AF      GET F.RPL OF DUMMY. 
      ADB K4
      LDB B,I 
      JMP ATL1
* 
ARR   OCT 600 
"C"   OCT 103 
B53   OCT 53        "+" 
B1777 OCT 1777
B20   OCT 20
B200  OCT 200 
"R"   OCT 122 
"P"   OCT 120 
KM4   DEC -4
"X"   OCT 130 
USE   NOP 
BCOM  OCT 3000
BCOMI OCT 7000
K31   DEC 31
EMFLG NOP 
* 
LOOP2 LDA IU4 
      CPB VAR       IF VARIABLE.
      JMP LOOP3 
      LDB F.ND      NUMBER OF DIMENSIONS
      CPB K1
      LDA IU5       1 DIM 
      CPB K2
      LDA IU6       2 DIM 
      CPB K3
      LDA IU7       3 DIM 
LOOP3 LDB USAGE     USAGE FIELD OF LINE 
      JSB .MVW
      DEF K9
      NOP 
      SPC 1 
*                   SUPPLY BCOM LABEL IF IN LABELED COMMON
* 
      LDA F.AT
      CPA BCOM      IN LABELED COMMON?
      RSS           YES SKIP
      JMP OL1       NO JUST OUTPUT THE LINE 
* 
      LDB F.AF      GET ADDRESS 
      LDA B,I        CHECK
      AND K7        TO SEE IF 
      ADB K2        OF THE MASTER ENTRY 
      LDB B,I       TO B
      CPA K4        EMA ARRAY?
      LDB F.EMA     YES  USE EMA MASTER ENTRY 
      JSB STOL      PUT SYMBOL IN THE LINE
      DBR LBUF+32 
      LDA K35       THIS LINE IS 35 WORDS LONG
      JMP OL2 
* 
*         OUTPUT LINE 
      SPC 1 
OL1   LDA K35 
      LDB TYPE,I    IF TYPE IS BLANK
      CPB DLBU.,I   2 BLANKS
      LDA K19       PRINT ONLY 19 WORDS 
OL2   LDB DLBU. 
      JSB PSL.F     PRINT THE LINE. 
      JSB IFBRK     CHECK FOR BREAK 
      DEF *+1 
      SSA           CONTINUE IF NOT 
      JMP BREAK     ELSE GO ABORT 
* 
      LDA F.A,I      MARK ITEM OFF
      IOR KK01      SO IT WON'T BE LOOKED AT AGAIN. 
      STA F.A,I 
      JMP OLOOP     FIND NEXT ITEM TO PRINT.
* 
ASSLC NOP           ASSBF PTR 
SAV.A NOP           THE LOWEST S.T. ENTRY SO FAR. 
      SPC 1 
K3    OCT 3 
K9    DEC 9 
K19   DEC 19
K35   DEC 35
B40   OCT 40
B2000 OCT 2000
DUM   OCT 5000
KK01  OCT 100000
      SPC 1 
SUB   OCT 200 
VAR   OCT 400 
COM.  OCT 4000
INT   OCT 10000 
REA   OCT 20000 
LOG   OCT 30000 
CPX   OCT 50000 
LO1   DEF LO1A
LO2   DEF LO2A
LO3   DEF LO3A
LO4   DEF LO4A
LO5   DEF LO5A
IM1   DEF IM1A
IM2   DEF IM2A
IM3   DEF IM3A
IM4   DEF IM4A
IM5   DEF IM5A
* 
DLBU. DEF LBUF
ADDR  DBL LBUF+5
ADDR2 DBR LBUF+7
USAGE DEF LBUF+12 
TYPE  DEF LBUF+22 
LOCAT DEF LBUF+27 
* 
IU1   DEF IU1A
IU2   DEF IU2A
IU3   DEF IU3A
IU4   DEF IU4A
IU5   DEF IU5A
IU6   DEF IU6A
IU7   DEF IU7A
IU8   DEF IU8A
      SKP 
*     ** PROCESSING COMPLETED **
* 
*         *********************** 
*         * OUTPUT LIST ROUTINE * 
*         *********************** 
      SPC 1 
LIST  NOP 
      LDA SLBUF 
      LDB A 
      CMA,CCE,INA   SET NEG.
      ELA           DOUBLE AND ADD ONE OF ODD CHAR. 
      ADA ASSLC     CHAR COUNT +1 
      ARS           FORM WORD COUNT 
      JSB PSL.F     PRINT IT. 
      JMP LIST,I
      SPC 2 
LABLE DEF SYTH
HEADR DEF SYTH2 
K7.   OCT 7 
* 
*         * CLEAR LIST BUFFER * 
      SPC 1 
CLR1  NOP 
      LDA LABLE,I   2 BLANKS
      LDB SLBUF 
SBBB  STA B,I 
      INB          ADVANCE POINTER
      CPB LAST     BUFFER ENDED?
      JMP CLR1,I
      JMP SBBB     NO.
* 
LAST  DEF LBUF+41   PTR TO NEXT AFTER LAST OF LBUF
SLBUF DEF LBUF
      SKP 
*      ** DATA TO OCTAL ASCII CONVERSION ** 
      SPC 1 
*     CALLING SEQUENCE:  LDB (DATA WORD)
*                        LDA (ADDRESS AT START OF STORAGE)
*                        JSB ASCI6
      SPC 1 
ASCI6 NOP           OUTPUT 6 DIGITS 
      STA ASSLC     SET THE ADDRESS 
      LDA KM6       GET NO. OF DIGITS TO CONVERT
      RBL           MOVE FIRST DIGIT TO LOW B 
      JSB NUM.F     CONVERT THE NUMBER
      JMP ASCI6,I   RETURN
      SPC 2 
ASCI5 NOP           5 DIGITS & BLANK
      LDA KM5       GET NO OF DIGITS TO CONVERT 
      BLF           POSITION FIRST DIGIT
      JSB NUM.F     CONVERT THE NUMBER
      JMP ASCI5,I   RETURN
* 
*                   *********************************** 
*                   * CONVERT DIGITS TO ASCII  BASE 8 * 
*                   *********************************** 
* 
* 
NUM.F NOP 
      STA T1NUM     SAVE THE DIGIT COUNT
      CPA KM6       IF 6 THEN 
      CLA,INA,RSS   USE 1 AS A MASK FOR FIRST DIGIT 
NUM00 LDA K7        ELSE USE 7
      AND B         ISOLATE THE DIGIT 
      ADA "0"       ADD 60 TO MAKE ASCII
      JSB PUT.F     PUT IN THE BUFFER 
      BLF,RBR       POSITION THE NEXT DIGIT 
      ISZ T1NUM     DONE? 
      JMP NUM00     NO  DO NEXT DIGIT 
* 
      JMP NUM.F,I   YES RETURN
* 
T1NUM NOP 
KM6   DEC -6
KM5   DEC -5
"0"   OCT 60
* 
      SPC 2 
* 
*                   ********************************
*                   * PUT CHARACTER IN LIST BUFFER *
*                   ********************************
* 
PUT.F NOP 
      STB T1PUT     SAVE B
      LDB ASSLC     GET CURRENT BUFFER ADDRESS
      AND B177      ISOLATE THE CHARACTER 
      CLE,ERB       WORD ADDRESS TO B E=UPPER,LOWER FLAG
      SEZ,RSS       IF UPPER CHAR 
      ALF,SLA,ALF   POSITION AND SKIP 
      XOR B,I       INCLUSION OF HIGHER CHAR. 
      XOR B40       ADD,TAKE AWAY LOWER BLANK 
      STA B,I       SET THE WORD DOWN 
      ISZ ASSLC     STEP THE CHAR ADDRESS 
      LDB T1PUT     RESTORE B 
      JMP PUT.F,I   RETURN
* 
T1PUT NOP 
      SPC 1 
      SKP 
*         *************************** 
*         * VARIABLES AND CONSTANTS * 
*         *************************** 
                                                                                                                                                                                                        