PAGE
*
*
*******************************************
*
*
*                <  PARAMETER CONVERTER  >
*                  ASCII:<BASE> - BINARY
*
*   VERSION 1.1   OCT. 25, 1976   S. DOMPIER
*
*   CALLING SEQUENCE:
*   reg HL has ASCII value string address
*   terminated by a binary zero.
*
*   PCONA:  reg B has alpha base chr
*   PCONB:  reg B has binary base
*
* max parameter values:  FFFF<:H>   65535:D
*          1111 1111 1111 1111:B   177777:Q
*
* alpha base notation:   B = binary
*                        O = octal
*                        Q = octal
*                        D = decimal
*                        H = hexidecimal
*
*
PCONA LXI D,PBTBL-1  base table
 XCHG
 MVI C,6  table entry count+1
 MOV A,B  get base chr
*
CBASE DCR C
 JZ ZRET  illegal base chr
 INX H
 CMP M
 INX H  point to next base chr/value
 JNZ CBASE
 MOV B,M  get binary base value
 XCHG
*
*   convert base-n digits to binary
*
PCONB MOV A,B  get base
 STA PBASE  save base
 PUSH H  save input buffer address
 LXI D,0  initialize total
*
CNUM2 LDA PBASE  get base
 MOV B,A
 POP H
 MOV A,M  get chr
 ORA A  binary zero?
 RZ .  yes, we are done
*
 INX H
 PUSH H  save CBUF pointer
 SUI 30H  strip ascii bias
 CPI 10  >10?
 JC CNUM3
 ANI 0DFH  upshift, if necessary
 SUI 7  strip alpha bias
 CPI 10H  illegal chr? > "F"
 JNC ZRET
 CPI 10
 JC ZRET
*
CNUM3 MOV C,A  save number
 SUB B  subtract base
 JP ZRET  not legal in base
 LXI H,0  clear temp total
 CALL MULT  total * base
 MVI B,1  one pass
 MVI D,0
 MOV E,C
 CALL MULT  add digit
 XCHG
 JMP CNUM2  get next digit
*
*
*   multilpy  DE*B
*
MULT INR B
MULT2 DCR B
 RZ .  done ~.~.~.~.~.~ EXIT ~.~.~.~.~
 DAD D
 JNC MULT2  continue if no overflow
 JMP ZRET  > 64K error
*
*
*   alpha base table
*
PBTBL DW 242H  'B' binary
 DW 84FH  'O' octal
 DW 851H  'Q' octal
 DW 0A44H  'D' decimal
 DW 1048H  'H' hexidecimal
*
*
MAXIN EQU 20  maximum chr input count
*
*
*    THIS IS THE REST OF PSCAN FROM PAGE "B" UP TOP
*
*   error returns
*
ERRET CALL PREAD  set-up error return address
ZRET XRA A  zero reg A = field error
ERET STC .  set carry = error
 MOV E,A  error number to reg E
 JMP PNR2
*
*
PREAD CPI 0D5H  ascii in HL from base in B?
 LHLD UIBUF  -> USER INPUT
 JNZ PR2  nope
 CALL PCONB  convert value; returns DE
 JMP PNR1  normal return
*
*
PR2 ANI 20H  one chr only?
 JZ R1  no
 CALL G1  get one chr from CI or user buffer
 STA LC
 JMP PNR1  go home
*
*
*   read chrs into OUBUF
*
R1 MVI C,0
 LHLD UOBUF
R2 CALL GETCH  get chr
 JZ STOP  done, found delimiter ,/;/cr
 MOV M,A  store chr in UOBUF
 INX H
 INR C  update chr count
 MVI A,MAXIN  maximum input count
 SUB C
 RZ .  to many chrs
 JMP R2  get next chr
*
*
*   get input character
*      RETURN IN A,  ZERO IF DELIMITER
*
GETCH PUSH H  save output pointer
GETC2 CALL G1
 CPI ' '  skip spaces
 JZ GETC2
 MOV L,A  SAVE CHR IN L
 LDA OPT
 ANI 88H
 ADD A  SET CARRY AND ZERO FLAGS FOR JUMPS BELOW
 MOV A,L  RESTOR CHR
 POP H
 JNZ DLTEST  SKIP ALL BUT NORMAL DELIMITERS
 JC DLMTST  VALUE OP, SKIP NO DELIMITERS
 JMP DLTST  NAME OP, SKIP ALL BUT NAME DELIMITERS
*
*
G1 LDA OPT
 ANI 40H  user input buffer?
 JNZ G2  yes
 LDA CIFILE  get cifile number from DOS
 PUSH B
 CALL RB  read one byte from cifile
 JMP ERET
 POP B
 RET
*
*
G2 LHLD UIBUF  get user input buffer pointer
 MOV A,M
 INX H
 SHLD UIBUF
 RET
*
*
STOP MVI M,0  set stop byte (last UOBUF chr),
 MOV L,C  stops scan in PCON or puts 0
 MOV H,A  after name
 SHLD CCLC  save chr count and last chr scanned
 MOV A,C
 ORA A  any characters?
 JZ PNRET  nope, its a default field
 LHLD UOBUF  get name/scratch buffer pointer
 LDA OPT  get options
 MOV B,A
 ANI 8  CHECK IF READ ALL CHRS TO NORMAL,
 JNZ PNRET  RETURN CHR - , ; cr 0
 MOV A,B
 RAL .  name?
 JNC NAME
*
* VALUE FIELD
*
 DCX H
 MVI B,'H'  set hexidecimal base default
*
V2 INX H
 MOV A,M
 ORA A
 JZ V3  if binary zero, field is finished
 SUI ':'  base?
 JNZ V2  no, look for ':' or binary zero
 MOV M,A  set binary zero in place of ':'
 INX H
 MOV B,M  get base chr
 INX H
 CMP M  better be zero!
 RNZ .  error, only one base chr allowed.
*
V3 LHLD UOBUF  point to value string
 CALL PCONA  convert ascii string to binary
 POP H
 RET .  normal return, value in DE
*
*
*   NAME FIELD
*
NAME LDA LC  GET LAST CHR SCANNED
 CALL DLTEST  CHECK IF , ; cr 0
 MVI A,-1  REG E = -1 ON RETURN,
 JNZ NOPEN  FILE NOT CREATED OR OPENED
*
 MOV A,M  GET FIRST NAME CHR
 CPI '#'  file number?
 LXI B,0A00H  SET C=0 & BINARY BASE = 10
 JNZ N1  NOPE
 INX H
 CALL PCONB  CONVERT FILE NUMBER TO BINARY
 POP H  CLEAR STACK FOR NORMAL RETURN
 RET
*
*
N1 LDA OPT  GET OPTIONS
 ORA C  ADD IN POSSIBLE SUPPRESS CREATE FROM OPEN
 RAR .  suppress create?
 LHLD UOBUF  POINT TO NAME
 JC POPEN  yes
 LXI D,-4  POINT TO TYPE (CREATE BLOCK)
 DAD D
 XCHG
 CALL SYS
 DB CREOP  create file
 JMP CREER  something wrong
CRNR MVI C,1  set suppress create
 JMP N1  now attempt to open file
*
*
CREER CPI ERAEX  existing file?
 JNZ ERET  no, something else wrong
 LDA OPT  get options
 ANI 2  . force create?
 JZ CRNR  no, open file
 MVI A,ERAEX  yes; and,
 JMP ERET  set existing file error.
*
*
*   OPEN, DE HAS UOBUF WITH NAME
*
POPEN LXI D,0  clear value/ set static buffer
 RAR .  suppress open?
 RAR
 JC PNRET  yes, return
 XCHG .  name pointer to DE,
 CALL SYS  static buffer to HL.
 DB OPEOP  open named file
 JMP ERET  opps!
*
*
NOPEN MOV E,A  save file number OR -1
 MVI D,0  clear reg D
 POP H  return, with file number in E
 RET
*
*
*
*
*   LAST WORD LOADED
*
 DB 0  THIS BYTE IT A SPARE
*
SP2 EQU $-1
LNSPA EQU SP2-SP1+1  LENGTH OF SYSGLOBL (DO NOT CHANGE)
*
*   *** WARNING, MAX = 380H   (ELSE MOVE SYS GLO AREA) ***
*
*