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 
                                                                                                                                                                                                                              