ASMB,R,L,C,Z
* 
*   N OPTION FOR DISKETTE SYSTEM
* 
*   Z OPTION FOR CARTRIDGE SYSTEM 
* 
* 
* 
*     NAME:   GTFIL 
*     SOURCE: 92064-18173   (DISKETTE SYSTEM) 
*     RELOC:  92064-16058   (DISKETTE SYSTEM) 
*     PGMR:   G.L.M.
* 
*     NAME:   GTFIL 
*     SOURCE: 92064-18061   (CARTRIDGE SYSTEM)
*     RELOC:  92064-16061   (CARTRIDGE SYSTEM)
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
* 
      IFN 
      NAM GTFIL,7  92064-16058  REV.1650  761020
      XIF 
* 
* 
* 
* 
      IFZ 
      NAM GTFIL,7  92064-16061  REV.1650  761020
      XIF 
* 
      ENT GTFIL 
* 
      EXT .DRCT,CLOSE 
      EXT CLD.R,.P1,.P2,.P3,.P4 
      EXT .ENTR,$PARS,$LIBR,MGLU
      EXT $LIBX,$CON,.MVW 
      EXT DTTY,OPEN,READF,WRITF,GDCB
* 
* 
* 
* 
      SUP 
* 
******
ZERO  NOP 
******
.5    OCT 5         DEFAULT LU'S
.4    OCT 4 
.6    OCT 6 
      OCT 6 
.1    OCT 1 
.2    OCT 2 
ADRLU DEF * 
******* 
*  DON'T MESS WITH ANY OF THE ABOVE!!!!!!!
* 
MSK1  OCT 140000
C.ARR NOP 
N6    OCT -6
* 
* 
* 
* 
* 
READ BSS 20         NOTE INPUT LENGTH OF 20 WORDS 
INAD  ASC 3,INPUT 
OUAD  ASC 3,OUTPUT
LIAD  ASC 3,LIST
ERAD  ASC 3,ERROR 
S1AD  ASC 3,SCR1
S2AD  ASC 3,SCR2
* 
*      DO NOT CHANGE THE FOLLOWING DEF'S
*    THEY ARE A TABLE TO DERIVE THE PROPER ASCII MESSAGE
* 
      DEF INAD
      DEF OUAD
      DEF LIAD
      DEF ERAD
ADSC1 DEF S1AD
ADSC2 DEF S2AD
* 
MUAD  DEF * 
* 
* 
***************************************************** 
* 
MESG  BSS 3 
      ASC 2, ?
      OCT 3537      BELL / BACK ARROW 
* 
MESAD DEF MESG
* 
MORE? NOP 
.3    OCT 3 
PADDR DEF SCR2+1
RBUF  BSS 33
RBUFA DEF RBUF
WD5   NOP 
N10   DEC -10 
N12   DEC -12 
N20K  OCT 157777
.9    DEC 9 
B77   OCT 77
ODD   OCT 52525 
RZERO DEF DZERO 
OPOP  OCT 411       OPEN OPTION 
CON1  NOP 
CLSE? NOP 
      SKP 
* 
* 
GTFIL NOP 
      LDA RZERO     FETCH RESET VALUE ADDR. 
      LDB A 
      INB           DESTINATION IS (A) +1 
      JSB .MVW      GO RESET PARMS
      DEF .9
      NOP 
* 
* 
      IFN 
      CLA 
      STA T267F 
      XIF 
* 
* 
      LDA GTFIL 
      STA DGTFL     SET PARM ADDR FOR .ENTR 
      JMP DUMMY     GO GET PARMS
* 
* 
********************************************************
DZERO DEF ZERO      DON'T MOVE THIS(USED IN RESET)     *
*                                                      *
OPTN  DEF ZERO                                         *
ERR   DEF ZERO                                         *
ANSW  DEF ZERO
INPT  DEF ZERO                                         *
OUTP  DEF ZERO                                         *
LIST  DEF ZERO                                         *
ELOG  DEF ZERO                                         *
SCR1  DEF ZERO                                         *
SCR2  DEF ZERO                                         *
*                                                      *
********************************************************
DGTFL NOP 
* 
DUMMY JSB .ENTR     TRANSFER PARAMETERS 
      DEF OPTN      TO LOCAL AREA 
* 
      CLA           CLEAR ERROR RETURN
      STA ERR,I 
* 
      LDA $CON,I    FETCH CONSOLE LU
      AND B77       ISOLATE  IT 
      STA CON1      SAVE IT 
* 
      LDA OPTN,I
      STA OPTN
      STA CLSE?     IF SIGN SET--DON'T CLOSE ANSW 
      AND ODD       ISOLATE BITS THAT WOULD CAUSE OP. RESPONSE
      SZA,RSS       IF NONE SET, SKIP ANSW FILE OPEN
      JMP ADFL
* 
* 
*  OPEN INPUT FILE/LU 
* 
      LDA ANSW,I    FETCH ANSWER NAME/LU
      LDB N20K      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 TEMP      SAVE FOR CONVERSION 
* 
*  CALL ROUTINE TO CREATE MAGIC NAME
*    IF REQUESTED LU IS TOO LARGE OR NOT ASSIGNED 
*    MAGIC 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 TEMP      ADDRESS OF LU TO BE CONVERTED
READA  DEF READ      TEMP BUFFER FOR RESULT 
      LDA READA     FETCH ADDRESS  OF MAGIC NAME
      STA ANSW      SET IT FOR OPEN CALL
* 
OP1   JSB OPEN
      DEF OP2 
      DEF GDCB
      DEF ERR,I 
      DEF ANSW,I
      DEF OPOP
* 
OP2   LDA ERR,I 
      SSA 
      JMP DGTFL,I 
* 
* SEE IF INTERACTIVE
* 
      JSB .DRCT     FETCH 
      DEF GDCB          DIRECT ADDRESS OF DCB 
      ADA .2        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
      JSB DTTY      DETERMINE IF INTERACTIVE
      RSS 
DFILE CLA 
      STA INT       0=NO,1=YES
* 
* 
* 
* 
* 
* 
ADFL  LDA N6        FETCH LOOP CNTR 
      STA MORE?     SET IT
* 
NEXT  LDA OPTN      FETCH OPTION PARAMETER
      RAR,RAR       POSITION OPTION BITS TO 15/14 
      STA OPTN      UPDATE FOR NEXT PASS
* 
      AND MSK1      (B140000) ISOLATE BITS 15&14
      SZA,RSS       ANY WORK? 
      JMP BMP2      NO-TRY NEXT PASS
* 
*    FETCH ADDRESS OF CURRENT ARRAY 
* 
      LDB PADDR     FETCH ADDR OF END OF PARMS
      ADB MORE?     BACK UP TO CURRENT WORK 
      LDB B,I       FETCH ADDRESS OF THAT ARRAY 
      CPB DZERO     SEE IF PARM SUPPLIED
      JMP EX10      EXIT NOT ENOUGH PARMS 
* 
      STB C.ARR     SAVE AS CURRENT ADDRESS 
      CLB 
      STB WD5       CLEAR STATUS WORD 
* 
      SPC 5 
* 
*     IF THIS IS DEFAULT REQUEST-GO DO IT.
*        ELSE OUTPUT PROPER OPERATOR QUESTION 
*        FETCH INPUT AND PARSE**
* 
      LDA OPTN      FETCH CURRENT OPTION
      SSA           IF SIGN SET=ODD REQUEST=DEFAULT 
      JMP DFLT
* 
*    -NOT DEFAULT-
*     MOVE IN PROPER MESSAGE
* 
PNT   LDA MORE?     INDEX TO
      ADA MUAD          PROPER MESSAGE TYPE 
      LDA A,I       FETCH ADDRESS(INDIRECT PROBLEM???)
      LDB MESAD     OUTPUT BUFFER ADDRESS 
      JSB MVIT3     MOVE MESSAGE TO BUFFER
      JSB WR/RE     WRITE IT AND FETCH RESPONSE 
* 
* 
* 
      SPC 5 
* 
*        THE INPUT BUFFER MUST BE PARSED*** 
* 
* 
*   SET TRANS LOG TO CHAR 
*    IF ZERO LOG, (CNTR D, OR ERROR) RETRY
* 
      LDB RLEN      FETCH READ LENGTH 
      SSB,RSS 
      SZB,RSS 
      JMP EX12      BAD INPUT ERROR--ABORT WORK--RETURN 
* 
      CLE,ELB       MAKE TRANS LOG CHAR 
      STB RLEN      SAVE IT FOR SYSTEM PARSE
      CMB,INB       SET IT NEGATIVE 
      STB RL2       SAVE IT TOO 
* 
      LDA IBCH      FETCH IBUF CHAR ADDRESS 
      STA FBYTE     SET FOR BUFFER SCAN 
      STA TBYTE           TO REPLACE ":" WITH "," 
* 
NX:   JSB GTBYT     FETCH BYTE
      CPA COLON     BAD GUY?
      LDA COMMA     YES--REPALACE IT
      JSB STBYT     GO STORE BYTE 
      ISZ RL2       DONE? 
      JMP NX:       NOPE --CONTINUE 
* 
      LDB RLEN      FETCH CHAR COUNT
      LDA READA     FETCH ADDRESS OF INPUT BUFFER 
* 
*     GO PRIV AND CALL SYSTEM PARSE ROUTINE 
* 
      JSB $LIBR 
      NOP           REQUEST PRIV MODE 
      JSB $PARS     CALL SYSTEM PARSE ROUTINE 
      DEF RBUF      RESULT BUFFER 
      JSB $LIBX     RESTORE NORMAL USER MODE
      DEF *+1 
      DEF *+1 
* 
*   CHECK PARSE RESULTS 
* 
* 
      LDB RBUFA     FETCH ADDR OF RESULT BUF
      LDA B,I       FETCH FLAG WORD 1 
      SZA,RSS       NULL? 
      JMP DFLT      YES--THE OPERATOR DEFAULTED 
* 
      CPA .2        ALPH? 
      JMP ALPH?      YES,NAME GIVEN 
* 
*  NUMERIC VALUE GIVEN
* 
      INB           ADVANCE TO VALUE
      LDA B,I       FETCH IT
GTMJ  CLB 
* 
      STB C.ARR,I   CLEAR WD1 OF ARRAY
* 
* 
STLU  STA TEMP      SAVE LU FOR CONVERSION
* 
* 
      JSB MGLU      GO GET MAGIC LU NAME FOR THIS GUY 
       DEF *+3
       DEF TEMP      LOCATION OF LU 
       DEF READ      LOCATION FOR RESULT
      LDA READA     ADDRESS OF RESULT 
      LDB C.ARR     FETCH CURRENT ARRAY ADDRESS 
      INB           ADVANCE TO WD2
      JSB MVIT3     MOVE MAGIC NAME IN
* 
      INB           ADVANCE TO SECURITY ADDRESS 
      CLA           SET IT
      STA B,I           EQUAL TO ZERO 
      JMP BUMP
* 
* 
* 
ALPH? INB           ADVANCE TO FIRST WD OF NAME 
      STB A         SET AS FROM ADDRESS 
      LDB C.ARR     FETCH CURRENT ARRAY ADDRESS 
      INB           ADVANCE TO WD2
      JSB MVIT3     GO MOVE NAME IN 
* 
*  A=ADDRESS OF FLAG FOR SECURITY CODE
*  B=ADDRESS OF WORD 5 OF GTF ARRAY 
* 
      INB           ADVANCE TO SECURITY 
      STB TEMP      SAVE ADDRESS FOR SECURITY 
      LDB A,I       FETCH FLAG
      INA           ADVANCE TO SECURITY VALUE 
      SZB           IF DEFAULT--USE ZERO
      LDB A,I       FETCH IT
      STB TEMP,I    SET IT INTO WD6-GTF ARRAY 
      ADA .3        ADVANCE TO DRN/-LU/0 FLAG 
      LDB A,I       FETCH FLAG
      INA           ADVANCE TO VALUE
      SZB           IF DEFAULT--USE 0 
      LDB A,I       FETCH IT
      STB C.ARR,I   SET IT INTO WD1 
      JMP BUMP
* 
* 
* 
* 
*     TO GET HERE EITHER: 1-THE OPTION BIT WAS ODD. 
*                      OR 2-THE OPERATOR DEFAULTED. 
* 
* 
DFLT  LDA WD5       FETCH TEMP WORD 4 OF ARRAY
      CCE           SET E 
      RAL,ERA         SET DEFAULT BIT 
      STA WD5       RESET TEMP FOR MORE UPDATES 
* 
      LDB .2        CHECK FOR 
      ADB MORE?                SCRATCH REQUEST
      SSB,RSS       IF SIGN BIT SET--NOT SCRATCH REQUEST
      JMP SCTCH     SIGN BIT NOT SET--SCRATCH-- 
* 
      LDA C.ARR,I         LU SUPPLIED?
      SZA,RSS       IF NOT--
      JMP DLU               --GO GET DEFAULT LU 
* 
*   ALLOW BOTH POS AND NEG LU'S TO BE PASSED FROM USER
*       MAY WANT TO ONLY ALLOW -LU
* 
* 
      SSA 
      CMA,INA       MAKE IT POS 
      JMP GTMJ      GO GET MAGIC NAME 
* 
      SPC 5 
* 
* 
TEMP  EQU GTFIL 
* 
* 
* 
*    FETCH DEFAULT LU FOR THIS PASS 
* 
DLU   LDA MORE?     FETCH PASS CNTR 
      ADA ADRLU     LOCATE ADDRESS OF DEFAULT LU
      LDA A,I       FETCH  LU 
      JMP GTMJ      GO SET THIS INTO MAGIC NAME 
* 
* 
      SPC 5 
MVIT3 NOP 
      JSB .MVW
      DEF .3
      NOP 
      JMP MVIT3,I 
* 
      SPC 5 
* 
*      PRINT/READ SUBROUTINE
* 
INT   NOP 
WR/RE NOP 
* 
*  IF NOT INTERACTIVE-SKIP PROMPT 
* 
      LDA INT 
      SZA,RSS 
      JMP RT1 
* 
      JSB WRITF 
      DEF RT1 
      DEF GDCB
      DEF ERR,I 
      DEF MESG
      DEF .6
* 
*     FETCH REPLY 
* 
RT1   JSB READF 
      DEF RT2 
      DEF GDCB
      DEF ERR,I 
      DEF READ
      DEF .20 
      DEF RLEN      READ LENGTH 
* 
RT2   LDA ERR,I 
      SZA 
      JMP DGTFL,I 
      JMP WR/RE,I 
* 
.20   DEC 20
* 
* 
BUMP  LDA C.ARR 
      ADA .4        POINT AT WD 4 OF ARRAY
      LDB WD5       FETCH DFLT//SCRN INFORMATION
      STB A,I       SET INTO USER ARRAY 
* 
BMP2  ISZ MORE?     ALL DONE? 
      JMP NEXT      NOPE-- CONTINUE 
* 
* 
      IFN 
* 
* 
* 
      LDA T267F     IF WDS 27&28 WERE MODIFIED
      SZA,RSS       GO
      JMP EXCLS 
      DLD T267      RESET 
      JSB ST278        THEM 
* 
      XIF 
* 
* 
*   EXIT   *
* 
*  IF SIGN WAS SET ON GETFIL OPTION THEN DON'T CLOSE ANSW FILE
* 
EXCLS LDA CLSE?     FETCH ORIGIONAL OPTION
      SSA           IF SIGN CLEAR GO CLOSE ANSW FILE
      JMP EX.2      NOPE --HARVEY WANTS IT LEFT OPEN,BYE
* 
      JSB CLOSE 
      DEF EX.2
      DEF GDCB
EX.2  LDA ERR,I     LOAD ERROR CODE 
      JMP DGTFL,I 
* 
* 
* 
      SPC 5 
* 
* 
EX10  LDA N10 
      RSS 
* 
EX12  LDA N12 
* 
      STA ERR,I     SET MASTER ERROR CODE WD
* 
*       THIS WD WILL CONTAIN THE LAST ERROR CODE ONLY 
* 
      JMP EXCLS     SEE ABOUT CLOOSING INPUT--EXIT     !! 
* 
* 
      SKP 
* 
* 
SCTCH ISZ WD5       SET SCRATCH BIT 
* 
* 
      IFZ 
* 
* 
*   ELSE--IF B=0 GIVE SCR1 ON LCTU
*       --IF B=1 GIVE SCR2 ON RCTU
*         (B WAS SETUP BEFORE CALL TO SCTCH)
* 
* 
      SZB,RSS       SCR1 OR 2 
      LDA N4        SCR1! 
      SZB 
      LDA N5        SCR2! 
      STA C.ARR,I 
      JMP BUMP
* 
N4    OCT -4
N5    OCT -5
* 
      XIF 
      IFN 
      SKP 
* 
* 
* 
      INB           IF ZERO--GIVE SCR1
*                   IF 1---GIVE SCR2
      ADB B60       FORM   ACSII DIGIT
      STB TEMP              FOR FIRST CHAR  (1 =SCR1, 2=SCR2) 
* 
      CLB 
      STB .P2       CLEAR -LU/+DRN WORD FOR CALL TO D.RFP 
* 
*  BUILD SRCATCH NAME 
* 
      LDA XEQT      FETCH ID SEG ADDRESS
      ADA .12       ADVANCE TO NAME 
      CLE,ELA       MAKE IT A BYTE ADDRESS
      STA FBYTE     SAVE IT FOR MOVE
      LDA C.ARR     FETCH ADDRESS 
      INA                   OF RESULT BUF 
      CLE,ELA       MAKE IT BYTE ADDRESSABLE ALSO 
      STA TBYTE      SAVE FOR MOVE
* 
      LDA N5        SET COUNTER 
      STA RL2            FOR 5 BYTES
* 
      LDA TEMP      FETCH FIRST CHAR OF NAME
      JSB STBYT     GO SET IT 
* 
*   MOVE IN PROGRAM NAME
* 
MNME  JSB GTBYT     GO GET BYTE FROM NAME 
      JSB STBYT     GO SET INTO BUF 
      ISZ RL2       BUMP COUNT, DONE??
      JMP MNME      NOPE
* 
*   SETUP D.RFP CALL TO CREATE SCRATCH FILE 
* 
AGAIN JSB .DRCT 
      DEF .P3       FETCH DIRECT ADDRESS FOR MOVE 
      STA B 
      LDA C.ARR     FETCH 
      INA             ADDRESS OF NAME 
      JSB MVIT3     GO MOVE INTO CALL FOR CREATE
* 
      LDA T267F     SEE IF WDS 27&28 SAVED YET
      SZA           IF DONE 
      JMP GTDNE     CONTINUE
* 
      ISZ T267F     SET SAVED FLAG
      LDA XEQT      ELSE
      ADA .26       SAVE EM 
      STA W27       SAVE ADDRESS FOR RESTORE
      DLD A,I 
      DST T267
* 
GTDNE CLA           CLEAR RECORD SIZE 
      CLB           CLEAR SECURITY CODE 
      JSB ST278     GO SET THEM INTO THE IDSEG WDS 27&28
* 
GTD2  CLA,INA       SET 
      STA .P1          FUNCTION CODE
      LDA .3        FETCH TYPE
      LDB .60       FETCH SIZE
* 
      JSB CLD.R     GO DO IT
* 
      LDA B,I       ANY ERRORS? 
      SSA,RSS 
      JMP OK:       NOPE
* 
      CPA N2        IF DUPLICATE NAME 
      JMP PGE       GO PURGE IT OFF 
* 
SCERR LDB C.ARR     FETCH RESULT BUFFER 
      INB           ADVANCE TO WD2
      STA B,I       SET ERROR CODE
      STA ERR,I     SET MASTER CODE 
      JMP BUMP      GO DO NEXT GUY
      SPC 5 
PGE   LDA .P4       FETCH WORD 4 OF NAME
      CCE           SET SIGN
      RAL,ERA       TO INDICATE 
      STA .P4       SCRATCH PURGE 
* 
*    SET UP OPEN CALL TO D.RFP
* 
      LDA .11       SET FUNCTION CODE 
      STA .P1 
      JSB CLD.R     GO DOIT 
* 
      LDA B,I       ANY ERRORS? 
      SSA,RSS       WELL
      JMP AGAIN     GO DO CREAT NOW 
      JMP SCERR     NOPE --SET ERROR
* 
      SPC 5 
OK:   INB 
      LDA B,I 
      LDA .P2       FETCH TR/LU 
      AND B77       ISOLATE LU
      CMA,INA       SET IT NEG
      STA C.ARR,I   SAVE IT FOR CALLER
* 
      LDA C.ARR     FETCH ADDRESS OF CALLER'S BUF 
      ADA .5        ADVANCE TO SECURITY WORD
      CLB 
      STB A,I       SET ZERO SEC CODE 
      JMP BUMP
* 
* 
      SPC 5 
ST278 NOP 
      JSB $LIBR     N 
      NOP 
      DST W27,I 
      JSB $LIBX 
      DEF ST278 
      SPC 5 
W27   NOP 
T267F NOP 
N2    OCT -2
N5    OCT -5
.11   DEC 11
.12   DEC 12
.60   DEC 60
B60   OCT 60
.26   DEC 26
T267  BSS 2 
* 
      XIF 
      SKP 
* 
* 
*    BYTE MOVE SUBS 
* 
*    SET:FBYTE=BYTE ADDRESS OF DATA TO BE MOVED 
*        TBYTE=BYTE ADDRESS OF RESULT FIELD 
* 
*        JSB GTBYT   TO FETCH BYTE--RETURNS IN LOW BYTE 
* 
*        JSB STBYT    SO SET BYTE--EXPECTED IN LOW BYTE 
* 
* 
GTBYT NOP 
      LDA FBYTE     FETCH ADDRESS 
      CLE,ERA       PUT BYTE FLAG INTO E
      LDA A,I       FETCH WORD HOLDING BYTE 
      SEZ,RSS       IF HIGH BYTE
      ALF,ALF       POSITION TO LOW]
      AND B377      ISOLATE REQUESTED BYTE
      ISZ FBYTE 
      JMP GTBYT,I   EXIT
* 
* 
* 
* 
* 
STBYT NOP 
      STA TEMP      SAVE BYTE TO BE MOVED 
      LDB TBYTE     FETCH DESTINATION BYTE ADDRESS
      CLE,ERB       PUT BYTE FLAG INTO E
      LDA B,I       FETCH DESTINATION WORD
      SEZ,RSS       REQUESTED BYTE POS TO LOW BYTE
      ALF,ALF 
      AND HBYTE     SAVE THE HIGH BYTE
      IOR TEMP      INCLUDE NEW BYTE
      SEZ,RSS       SHIFT TO HIGH BYTE IF NEEDED
      ALF,ALF 
      STA B,I       RESTORE DESTINATION WORD
      ISZ TBYTE     BUMP DESTINATION ADDRESS
      JMP STBYT,I   EXIT
* 
* 
FBYTE NOP 
TBYTE NOP 
B377  OCT 377 
RL2   NOP 
IBCH  DBL READ
RLEN  NOP 
HBYTE OCT 177400
COMMA OCT 54
COLON OCT 72
* 
* 
A     EQU 0 
B     EQU 1 
XEQT EQU 1717B
      END 
                                                                                                              