ASMB,R,L,C,N * * 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.1805 771017 XIF * * * * IFZ NAM GTFIL,7 92064-16061 REV.1801 771017 XIF * ENT GTFIL * EXT .DRCT,CLOSE EXT CLD.R,.P1,.P2,.P3,.P4 EXT .ENTR,$PARS,$LIBR,MGLU EXT $LIBX,$CON,.MVW EXT IFTTY,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 STA LUAD SET LU ADDRESS JSB IFTTY DETERMINE IF INTERACTIVE DEF *+2 LUAD NOP 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