ASMB,Q,C
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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.       *
*  ***************************************************************
* 
*     SOURCE PART NUMBER :92067-18407 
* 
*     RELOCATABLE PART NUMBER : 92067-16361 
* 
*     PROGRAMER(S)   : J.M.N. 
* 
* 
* 
* 
*     ACFMT FORMAT AND OUTPUT DATA
* 
      NAM ACFMT,7 92067-16361 REV.1940 790725 
      ENT ACFMT 
      EXT ACWRL,.ENTP 
      EXT ACOM2,NAM.. 
* 
* 
*     CALLING SEQUENCE: 
*      CALL ACFMT(IERR,F1,IBUF1,-N,F2,IBUF2,F3,...,FN,IBUFN)
* 
*       WHERE: F1,F2,...,FN,...  ARE FUNCTION CODES 
*              N     IS NUMBER OF BLANKS(NEXT PARM IS 
*                    A FUNCTION CODE
*     FUNCTION CODES ARE: 
*          WHERE: 0<FN<"I0"   PRINT N ASCII CHARACTERS
*                 FN=0        PRINT ASCII CHARACTERS
*                             UNTIL BLANK IS ENCOUNTERED
*                             (MAXIMUM NO OF CHARS FOLLOWS) 
* 
*                 FN="I0"     PRINT DECIMAL NUMBER
*                            WITHOUT LEADING BLANKS 
*                 "I0"<FN<"I6"   PRINT IN "IN" FORMAT 
* 
*     IBUF1,IBUF2,IBUF3,... ARE EITHER ASCII STRINGS
*                           OR NUMERIC DATA 
* 
* 
IERR  NOP 
IPARS BSS 30
ACFMT  NOP
      JMP CLPAR     GO CLEAR PARAMETER LINKS
      NOP           **THIS IS REQUIRED FOR .ENTP
ACFM0 JSB .ENTP     GET PARAMATER ADDRESSES 
      DEF IERR
* 
      LDA PARMS 
      STA PARPT     SET PARAMETER ADDRESS POINTER 
* 
      LDA BYADD     SET OUTPUT BUFFER BYTE POINTER
      CAX 
* 
NEXT  CCA           CLEAR BLANK STOP FLAG 
      STA IFLG
* 
      LDA PARPT,I   GET NEXT PARM ADDRESS 
      SZA,RSS       IF ZERO THERE ARE NO MORE 
      JMP END 
* 
      LDA A,I       GET FUNCTION CODE 
      ISZ PARPT 
NXT0  LDB PARPT,I   GET BUFFER ADDRESS
      CPA CR
      JMP CRCHK     IF CODE "CR" GO CHECK IF ASCII
      SSA           IF POSITIVE MUST BE ASCII OR INTEGER
      JMP NOTAS     ELSE BLANKS 
      ADA MI0       IS IT AN INTEGER
      SSA,RSS 
      JMP INTGR     YES 
      ADA I0        NO RESTORE A REG
* 
      ISZ PARPT     BUMP ADDRESS FOR NEXT 
      SZA           IF ZERO PRINT UNTIL A BLANK 
      JMP ASCII     ELSE PRINT N CHARS
* 
      LDA BLNK      SET BLANK STOP FLAG 
      STA IFLG
      LDA B,I       GET MAXIMUM NO OF CHARS 
      LDB PARPT,I   GET THE BUFFER ADDRESS
      ISZ PARPT     BUMP ADDRESS FOR NEXT 
* 
ASCII CMA,INA       SET CHAR COUNTER
      STA CNTR
      CLE,ELB       CONVERT TO BYTE ADDRESS 
LOOP2 LBT 
      CPA IFLG      IF CHAR IS A BLANK AND
      JMP NEXT      BLANK STOP FLAG SET GO GET NEXT FUNC
      JSB SBTX      TRANSFER STRING 
      ISZ CNTR
      JMP LOOP2 
      JMP NEXT      GO GET NEXT FUNCTION WHEN DONE
* 
*                   CHECK IF SC OR CRN IS LEAGAL FILE NAME
* 
CRCHK LDB B,I       GET DATA
      STB CRNAM     PUT IN 6 CHAR NAME
      JSB NAM..     GO TEST IT
      DEF *+2 
      DEF CRNAM 
      LDB A         IF A=0
      LDA A2        THEN PRINT AS ASCII 
      SZB 
      LDA I0        ELSE PRINT AS INTEGER 
      JMP NXT0
* 
A2    DEC 2 
CR    ASC 1,CR
CRNAM ASC 3,        6 BLANKS
NOTAS EQU * 
END   STA CNTR      NO,PRINT IABS(N) BLANKS 
      LDA BLNK
      XBX           GET OUTPUT BYTE ADDRESS 
LOOP3 CPB BYEND     DONT GO OFF END 
      JMP POST
      SBT 
      ISZ CNTR
      JMP LOOP3 
* 
      XBX 
      JMP NEXT            GO GET NEXT FUNCTION
* 
* 
INTGR CMA,INA 
      STA NDGTS     SAVE NUMBER OF DIGITS 
      SZA,RSS 
      LDA BLNK      IF ZERO SET IFLG TO 
      STA IFLG      SUPPRESS LEADING BLANKS 
      ISZ PARPT     BUMP FOR NEXT 
      LDA B,I       GET NUMBER
* 
      LDY TLADD 
      LDB BLKBL 
      STB TBUF      CLEAR WORKING BUFFER
      STB TBUF+1
      STB TBUF+2
* 
      SSA,RSS 
      JMP CNVT0 
      CMA,INA       MAKE POSITIVE 
      LDB DASH
CNVT0 STB ISGN
LOOP6 CLB           CONVERT NEXT LEAST SIGNIFICANT 2 DIGITS 
      DIV D10 
      STB TMP1
      SZA           IF MORE DIGITS GET NEXT DIGIT 
      JMP CNVT1 
      LDB ISGN      ELSE MERGE SIGN 
      BLF,BLF 
      ADB B20       ADJUST FOR CORRECT ASCII
      ADB TMP1
      SBY 0 
      JMP CNVT2 
* 
CNVT1 CLB 
      DIV D10       CONVERT NEXT DIGIT
      BLF,BLF 
      ADB TMP1      MERGE LOWER 
      ADB "00"      MAKE ASCII
      SBY 0 
      DSY           DECREMENT POINTER 
      SZA 
      JMP LOOP6     MORE TO CONVERT 
      LDB ISGN      ADD SIGN
      SBY 0 
CNVT2 LDB NDGTS     COMPUTE NO OF DIGITS
      SZB,RSS 
      LDB DM6 
      STB CNTR
* 
      ADB D6        AND STARTING ADDRESS
      ADB TBADD 
LOOP4 LBT 
      CPA IFLG
      RSS 
      JSB SBTX
      ISZ CNTR
      JMP LOOP4 
      JMP NEXT
* 
* 
POST  JSB ACWRL     WRITE BUFFER
      DEF RTRN
      DEF IBUF
      DEF D32 
      DEF IERR,I
RTRN  JMP ACFMT,I   RETURN
* 
CLPAR LDA DM30      CLEAR PARM ADDRESSES
      STA CNTR
      LDB PARMS 
      CLA 
LOOP5 STA B,I 
      INB 
      ISZ CNTR
      JMP LOOP5 
      JMP ACFM0     GO BACK AND GET PARMATERS ADDRESSES 
* 
* 
SBTX  NOP           STORE BYTE INTO ADDRESS 
      XBX           POINTED TO BY X REG 
      CPB BYEND     IF BUFFER END STOP
      JMP POST
      SBT 
      XBX 
      JMP SBTX,I
* 
A     EQU 0 
B     EQU 1 
XX    BSS 1 
CNTR  BSS 1 
PARMS DEF IPARS 
PARPT BSS 1 
IBUF  ASC 2,  * 
BUF   BSS 29
BUFEN ASC 1, *
BYADD DBL BUF 
BYEND DBL BUFEN 
BLNK  OCT 40
IFLG  BSS 1 
DM6   DEC -6
D10   DEC 10
B20   OCT 20
"00"  ASC 1,00   ** 
TMP1  BSS 1 
ISGN  BSS 1 
BLKBL ASC 1,       *****
DASH  ASC 1, -     **** 
TBADD DBL TBUF
TBUF  BSS 3 
TLADD DEF *-1 
DM30  DEC -30 
D32   DEC 32
D6    DEC 6 
I0    ASC 1,I0
MI0   OCT 133320
NDGTS BSS 1 
      END 
              