ASMB,R,L,C
      NAM GTF.C,7 92064-16090 780815 REV. 1901 $CLIB
* 
* 
* 
* 
*     NAME:   GTF.C 
*     SOURCE: 92064-18225 
* 
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
* 
*      CALLING SEQUENCE:  JSB GTF.C 
* 
* 
*         ERROR CODE RETURNED IN A REGISTER 
*         STRING LENGTH RETURNED IN B REGISTER
* 
* 
      ENT GTF.C 
* 
      EXT .DRCT,MGLU,IFTTY         UNKNOWN ROUTINES(POS FTN LIB)
      EXT CLOSE,OPEN,READF,WRITF,RMPAR   RTE-M REF MAN
      EXT .MVW                         ASMB MAN 
      EXT C.TRN,C.TTY                  COMPILER LIB 
* 
* 
GTF.C NOP 
* 
      JSB RMPAR 
      DEF *+2 
      DEF ANSW
      LDA C.TTY+2   FETCH CONSOLE LU
      AND =B77       ISOLATE  IT
      STA CON1      SAVE IT 
* 
* 
*  OPEN INPUT FILE/LU 
* 
      LDA ANSW      FETCH ANSWER NAME/LU
      LDB =B157777  IS THIS A NAME ?
      ADB A              OR AN LU ??
      SSB,RSS 
      JMP OP1       IT'S A NAME--DO NORMAL OPEN 
* 
      SZA,RSS       IF DEFAULT
      LDA CON1      USE MTM TERMINAL
      STA LU        SAVE FOR CONVERSION 
* 
*  CALL ROUTINE TO CREATE FILE NAME LU..XX  XX ::=  LU #
*    (IF REQUESTED LU IS TOO LARGE OR NOT ASSIGNED
*    FILE NAME "LU..99" IS RETURNED. THIS WILL GENERATE 
*    A ERROR -18 (BAD LU)  IN THE OPEN ROUTINE.)
* 
      JSB MGLU      CALL ROUTINE TO BUILD MAGIC NAME
       DEF *+3
       DEF LU        ADDRESS OF LU TO BE CONVERTED
       DEF ANSW     SET IT FOR OPEN CALL
* 
OP1   JSB OPEN
      DEF OP2 
      DEF GDCB
      DEF ERR 
      DEF ANSW
      DEF OPOP
* 
OP2   LDA ERR 
      SSA 
      JMP GTF.C,I 
* 
* SEE IF INTERACTIVE
* 
      JSB .DRCT     FETCH 
      DEF GDCB          DIRECT ADDRESS OF DCB 
      ADA =B2       ADVANCE TO TYPE WORD
      LDB A,I       FETCH IT
      SZB           CONTINUE IF ZERO
      JMP DFILE     NON-INTERACTIVE 
* 
      INA           ADVANCE TO LU 
      LDA A,I       FETCH IT
      STA X 
      JSB IFTTY      DETERMINE IF INTERACTIVE 
      DEF RTN 
      DEF X 
RTN   RSS 
DFILE CLA 
      STA INT       0=NO,1=YES
* 
* 
      LDA STAA
      INA 
      INA 
      STA STAD    PRESET STRING POINTER 
      LDA .5
      STA LEN      PRESET STRING LENGTH (ALLOWS FOR RU,X, , , ) 
      LDA =B-3      FETCH LOOP CNTR 
      STA CNTR      SET IT
* 
*  SET UP ADDRESSES 
* 
INPT  LDA PNT2
      ADA CNTR
      LDA A,I 
      STA MSAD
      ADA .5
      INA 
      STA LNAD
      INA 
      STA RDAD
* 
*  IF NOT INTERACTIVE-SKIP PROMPT 
* 
      LDA INT 
      SZA,RSS 
      JMP RT1 
      JSB WRITF 
      DEF RT1 
      DEF GDCB
      DEF ERR 
      DEF MSAD,I
      DEF .5
* 
* 
*     FETCH REPLY 
* 
RT1   JSB READF 
      DEF RT2 
      DEF GDCB
      DEF ERR 
      DEF RDAD,I    REPLY 
      DEF .20 
      DEF LNAD,I    READ LENGTH 
* 
RT2   LDA ERR 
      SZA 
      JMP EX0     ERROR EXIT FROM READ
* 
      ISZ CNTR
      JMP INPT
* 
      LDA =B-3    RESET COUNTER 
      STA CNTR
OUTPT LDA PNTR
      ADA CNTR
      LDA A,I 
      ADA .5
      STA DFAD
      INA 
      STA LNAD
      INA 
      STA RDAD
* 
* 
      LDB LNAD,I    LOAD LENGTH WORD
      LDA INT      CHECK SINCE DEFAULT ON TERMINAL = EOF
      SZA,RSS 
      JMP RT3 
      SSB,RSS      EOF FROM TERM = ZERO RECORD AS FROM FILE 
      SZB,RSS 
      CLB 
      STB LNAD,I
RT3   SSB 
      JMP EX12     ERROR EXIT 
      LDA RDAD
      SZB 
      JMP RPLY
      ISZ LNAD,I   INSERT DEFAULT IF REQD 
      ISZ LEN 
      LDA DFAD
RPLY  ADB LEN 
      STB LEN      INCREMENT STRING LENGTH
      LDB CMA 
      STB STAD,I
      LDB STAD
      INB 
      JSB .MVW
      DEF LNAD,I
      NOP 
      STB STAD     INCR STRING PNTR 
* 
* 
      ISZ CNTR
      JMP OUTPT 
* 
*   EXIT  * 
* 
EXCLS JSB CLOSE 
      DEF *+2 
      DEF GDCB
* LOAD RUN STRING * 
      LDB .CTRN 
      JMP *+2 
LOOP  LDB B,I 
      RBL,CLE,SLB,ERB      CLEAR INDIRECTS
      JMP LOOP
      LDA STAA
      JSB .MVW
      DEF LEN 
      NOP 
      LDA ERR      LOAD ERROR CODE
      LDB LEN        LOAD STRING LENGTH 
      BLS            (CHARACTERS,NO WORDS ARE EXPECTED) 
      JMP GTF.C,I 
* 
* ERROR EXIT *
* 
EX0   CLB 
      STB LEN 
EX12  LDA =D-12 
      STA ERR   SET MASTER ERRORCODEWORD
      JMP EXCLS 
* 
* 
* LOOP VARIABLES
* 
*   WORD  1- 5  PROMPT
*            6  LENGTH OF REPLY 
*            7  DEFAULT 
*         8-21  REPLY 
* 
INP  ASC 4,INPUT? 
     OCT 3537         (BELL/BACK ARROW) 
     ASC 1, 5 
     BSS 14           LENGTH WORD + 13W REPLY 
OUT  ASC 4,OUTPUT?
     OCT 3537 
     ASC 1, 4 
     BSS 14 
LST  ASC 4,LIST?
     OCT 3537 
     ASC 1, 6 
     BSS 14 
* 
     DEF INP
     DEF LST
     DEF OUT
PNTR DEF *
     DEF INP
     DEF OUT
     DEF LST
PNT2 DEF *
CNTR BSS 1
DFAD BSS 1
LNAD BSS 1
RDAD BSS 1
MSAD BSS 1
* 
*  RUN STRING 
* 
LEN  BSS 1
CMA  OCT 26040    LEFT JUST COMMA AND BLANK 
STAA DEF STR
STR  ASC 2,RU,X   X IS PLACEHOLDER FOR COMPILER NAME
     BSS 38 
STAD BSS 1
* 
* 
GDCB BSS 144       DCB BUFFER AREA FOR INPUT
.CTRN DEF C.TRN    LOCAL POINTER TO LIB 
ERR  BSS 1
ANSW BSS 5
OPOP OCT 411       OPEN OPTION
CON1 BSS 1
A    EQU 0
B    EQU 1
INT  BSS 1
LU   BSS 1
X    BSS 1
.5   OCT 5
.20  OCT 24 
     END
                                                                                                                                        