ASMB,R,L NAM ACFIL,7 92065-16008 REV 1726 770512 * ************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * ************************************************************** * * * * SOURCE 92065-18013 * * ENT MVNAM,FILRD,FILWR,CLFIL EXT READF,CLOSE,CREAT,OPEN,WRITF EXT $LIBR,$LIBX,$CVT1,.ENTR,EXEC EXT NAMR,.MBT,GETCR,.ENTR,EXEC COM TEMPS(30),PNTRS(61),SPEC(10) TTYPR EQU PNTRS+34 FLFIL EQU PNTRS+39 A EQU 0 B EQU 1 * DCB NOP REP 15 NOP BSS 128 * IPBUF BSS 10 .PARAMETER BUFFER FOR NAMR INBUF BSS 14 .NAMR INPUT BUFFER LENTH NOP .INPUT TEXT LENGTH ISTRC NOP * .1 OCT 1 M26 DEC -26 DPBUF DEF IPBUF CHAR NOP TEMP NOP SOUR DBR CHAR DEST DBL INBUF .DESTINATION BYTE ADDRESS SKP *************************************************** * * * THIS ROUTINE WILL MOVE THE FILENAME INTO A * * BUFFER FOR NAMR PROCESSING. THE FIRST CHARATER * * IS IN THE A REGISTER THE RETURN IS THROUGH * * P+2 TO INDICATE THE MODULE IS PRESENT FOR BASIC* * THE RETURN TROUGH P+1 IS FOR THE DUMMY VERSION * * OF THIS ROUTINE * *************************************************** * * MVNAM NOP STA CHAR .SAVE FIRST CHAR LDA M26 STA TEMP .CLEAR BUFFERS LDA DPBUF CLB AGAIN STB A,I INA ISZ TEMP JMP AGAIN * LDA .1 .SET FIRST CHARACTER COUNT STA ISTRC LDB DEST .SET UP FOR MOVING NAMR STB TEMP . INTO THIS ROUTINE TOP LDA SOUR JSB .MBT .MOVE THE CHARACTER DEF .1 NOP ISZ LENTH STB TEMP .SET UP FOR NEXT CHARACTER JSB GETCR JMP DONE .MOVE CHARACTERS UNTIL EOR STA CHAR LDB TEMP JMP TOP * DONE JSB NAMR .PROCESS NAMR RECORD DEF *+5 DEF IPBUF DEF INBUF DEF LENTH DEF ISTRC * ISZ MVNAM JMP MVNAM,I .EXIT WITH NAMR PROCESSED SKP ***************************************************** * * * THIS IS THE FILE READ ROUTINE FOR RETREIVING * * BASIC PROGRAMS FROM DISC. THIS ROUTINE WILL * * OPEN A SPECIFIED FILE IF NOT OPEN ALREADY. AND * * WILL GENERATE AN FMGR ERROR MESSAGE IF ANY FMP * * ERRORS ARE RETURNED * ***************************************************** * * M1 DEC -1 ZERO NOP IERR NOP ALEN NOP * BLEN DEF * BLOC DEF * FILRD NOP JSB .ENTR .FETCH PARAMETERS DEF BLEN * LDA DCB+9 CPA 1717B .CHECK FOR OPEN JMP RD3 .YES OPEN JSB DOOP .NO OPEN IT * RD3 LDB BLEN,I CMB,INB .CHANGE TO POSITIVE AND CLE,ERB . DIVIDE BY 2 SEZ .ADD ONE FOR ODD # CHAR INB STB TEMP * RD1 JSB READF DEF RD2 .READ A RECORD DEF DCB DEF IERR DEF BLOC,I DEF TEMP DEF ALEN DEF ZERO * RD2 LDA IERR SSA .FMP ERROR ? JSB ERROR .PRINT ERROR MESSAGE LDA ALEN .SET REGISTERS CLE,ELA .A= NUMBER ACTUAL CHARACTERS LDB IERR .B= FMP ERROR CODE JMP FILRD,I SKP **************************************************** * * * THIS ROUTINE WILL WRITE A RECORD OF BASIC * * SOURCE TO A FILE ON DISC. IT WILL OPEN OR * * CREATE A FILE IF IT IS NOT ALREADY OPEN * * IT WILL GENERATE A FMGR ERROR MESSAGE FOR ANY * * ERROR RETURN FROM A FMP CALL * **************************************************** * * UBYTE OCT 177400 LSPC OCT 40 * BFLEN DEF * BFLOC DEF * FILWR NOP JSB .ENTR .FETCH PARAMETERS DEF BFLEN * LDA DCB+9 .CHECK FOR FILE OPEN CPA 1717B JMP WR3 .YES OPEN JSB OP.CR .OPEN OR CREATE IT * WR3 LDB BFLEN,I .MAKE BUFFER LENGTH POSITIVE CMB,INB CLE,ERB . AND DIVIDE BY 2 SEZ INB ADD ONE FOR ODD STB TEMP SEZ,RSS .PAD WITH BLANK? JMP WR1 .NO ADB M1 .COMPUTE LAST WORD ADDRESS ADB BFLOC LDA B,I .FETCH LAST WORD OF BUFFER AND UBYTE .REMOVE LOW BYTE IOR LSPC .INSERT A SPACE STA B,I . SET INTO THE BUFFER * WR1 JSB WRITF .WRITE THE RECORD DEF WR2 DEF DCB DEF IERR DEF BFLOC,I DEF TEMP * WR2 LDA IERR SSA .ERROR? JSB ERROR .PRINT FMP MESSAGE WR4 CLA LDB IERR .SET A = 0 SET B=FMP ERROR CODE JMP FILWR,I .EXIT SKP **************************************************** * * * CHECK FOR FILE EXISTANCE - CREATE ONE IF NOT * * * **************************************************** * * .4 DEC 4 M6 DEC -6 OP.CR NOP JSB OPEN .TRY TO OPEN THE FILE DEF OP.1 DEF DCB DEF IERR DEF IPBUF DEF ZERO DEF IPBUF+4 .SEC CODE DEF IPBUF+5 .CART REF # * OP.1 LDA IERR .FILE NOW OPEN? SSA,RSS .NO TRY TO CREATE IT JMP OP.CR,I .YES RETURN CPA M6 .SIMPLY NOT FOUND ? JMP OP.2 .CREATE JSB ERROR .NO SOME OTHER PROBLEM JMP WR4 .PRINT MESSAGE AND GO * * CREATE IT * OP.2 LDA .4 .FORCE TO TYPE 4 STA IPBUF+6 LDA IPBUF+7 .SIZE DECLARED ? LDB LSPC SZA,RSS .IF NOT FORCE TO 32 BLOCKS STB IPBUF+7 JSB CREAT DEF OP.3 DEF DCB DEF IERR DEF IPBUF .NAME DEF IPBUF+7 .SIZE DEF IPBUF+6 .TYPE DEF IPBUF+4 .SEC CODE DEF IPBUF+5 .CART REF # * OP.3 LDA IERR .CREATED PROPERLY ? SSA,RSS JMP OP.CR,I .YES CONTINUE WITH WRITE JSB ERROR .NO PRINT FMGR MESSAGE JMP WR4 .EXIT WITH NO WRITE SKP ************************************************ * * * OPEN FOR READ A RECORD * * * ************************************************ * * DOOP NOP JSB OPEN DEF OOP.1 DEF DCB DEF IERR DEF IPBUF .NAME DEF ZERO DEF IPBUF+4 .SECURITY CODE DEF IPBUF+5 .CRN * OOP.1 LDA IERR SSA,RSS .ERROR? JMP DOOP,I .NO JMP RD2 .YES PRINT MESSAGE * ******************************************************* * * * CLOSE THE PROGRAM FILE * * ******************************************************* * CLFIL NOP JSB CLOSE .CLOSE THE FILE DEF CL.1 DEF DCB DEF IERR DEF ZERO * CL.1 CLA .RESET FILE FLAG STA FLFIL LDA IERR .CHECK FOR CLOSE ERROR SZA,RSS JMP CLFIL,I .NO ERROR JSB ERROR .PRINT ERROR MESSAGE JMP CLFIL,I SKP ********************************************** * * * FMP ERROR MESSAGE PRINT * * * ********************************************** * TWO DEC 2 M8 DEC -8 ERROR NOP JSB $LIBR NOP LDA IERR LDB SPMIN .SET BUFFER TO - OR + SSA,RSS LDB SPSP .IT IS + STB PBUF+2 SSA CMA,INA .MAKE ERROR CODE POSITIVE CCE .SET FOR DECIMAL CONVERTION JSB $CVT1 .CONVERT TO ASCII STA PBUF+3 JSB $LIBX .EXIT PRIVILEDGED MODE DEF *+1 DEF *+1 JSB EXEC .WRITE OUT TO CONSOLE DEF ERR.1 DEF TWO DEF TTYPR DEF PBUF DEF M8 * ERR.1 JMP ERROR,I PBUF ASC 4,FMGR SPMIN ASC 1, - SPSP ASC 1, END