//MIOC.BCPL -- TV to DVec and DVec to stream routines, also Wns
//	PutField, and MoveLongField.
//	Last edited: 1 November 1979

get "mdecl.d"

external [
// OS
	DefaultArgs; Puts; Zero; Min; DoubleAdd

// MINIT0
	@MBlock

// MIDAS
	MidasSwat

// MASM
	ErrorProtect; RepPuts; GetField; PutField; MoveLongField; DoubleNeg

// MSYM
	EvalAText; ChkToken

// Machine dependent
	DefRadix

// Defined here
	DWns; Wns; DataToStream; GenlTexttoDVec; SimpleTexttoDVec
]

//Convert an arbitrary sequence of numbers and address symbols separated
//by "+" and "-" into a DVec of size le 32 bits (mandatory use of Form
//feature for items bigger than 32 bits).  The radix is initialized to
//DefRadix, overruled by inserting "#" for octal, "!" for decimal, or "%"
//for hexadecimal before any item.
let SimpleTexttoDVec(TV,NBits,DVec,Radix,HNum,LNum; numargs NA) = valof
[	if NBits > 32 then MidasSwat(NBitsG32)
	if NA < 4 then Radix = DefRadix
	let W = (NBits+15) rshift 4; Zero(DVec,W)
	let CurrentResult = vec 1; Zero(CurrentResult,2)
	let Size,X,Negative = nil,1,false
	[ let Token = ChkToken(TV,lv X,lv Size)
	  if Token eq LimitToken then break
	  test Token eq SignToken
	  ifso if TV!X eq $- then Negative = true
	  ifnot
	  [ if Token ge MarkedOct then
		Radix = Token < MarkedDec ? 8,(Token < MarkedHex ? 10,16)
	    Token = Token & (MarkedOct-1)	//Strip radix marks
	    let EvalToken = selecton Radix into
	    [ case  8: OctToken*2
	      case 10: DecToken*2
	      case 16: HexToken*2
	      default: 0
	    ]
	    if EvalToken eq 0 then MidasSwat(BadRadix)
	    test (Token ge EvalToken) % (Token < OctToken)
	    ifso
//Character sequence is non-numeric--evaluate using EvalAText
	    [ let AVal = vec size AVal/16
	      if not EvalAText(TV,lv X,AVal,true) then resultis false
	      if AVal>>AVal.TypeStorage ne MemTypeStorage then
		resultis false
	      MBlock(lv HNum,lv AVal>>AVal.Addr,2)
	    ]
	    ifnot
//Have a sequence of valid number constituents
	    [ HNum,LNum = 0,0
	      for I = X to X+Size-1 do
	      [	let N = TV!I
		if (N eq $!) % (N eq $%) % (N eq $#) then loop
		(table [
//mul multiplies unsigned integers in 1 and 2 generating a 32-bit product;
//low order result added to 0 left in 1; high order result in 0
		#55001	//sta 3 1 2
		#155000	//mov 2 3	Preserve 2
		#31407	//lda 2 7 3	Radix
		#61020	//mul		0/ ovf of LNum*Radix + digit
		#45411	//sta 1 11 3	1/ new LNum
		#25410	//lda 1 10 3	HNum
		#61020	//mul		0/ ovf of HNum*Radix + low ovf
		#45410	//sta 1 10 3	1/ new HNum
		#171000	//mov 3 2
		#35001	//lda 3 1 2
		#1401		//jmp 1 3
		] )((N ge $A ? N-$A+10,N-$0),LNum)
	      ]
	    ]
	    if Negative then
	    [ DoubleNeg(lv HNum); Negative = false
	    ]
	    DoubleAdd(CurrentResult,lv HNum)
	  ]
	  X = X+Size
	] repeat
	MoveLongField(CurrentResult,32-NBits,NBits,DVec,0)
	resultis true
]

//DVec must be of size ge ValSize
and GenlTexttoDVec(TV,Form,DVec,Radix) = valof
[	let X,PV,PVptr = 1,vec 40,0
	let CDVec = vec ValSize
// Parse the groups of characters separated by blanks
//PV!i = ptr to 1st char of group, PV!(i+1) = nchars in group
	while X le TV!0 do
	[ if TV!X eq $  then
	  [ X = X+1; loop
	  ]
	  PV!PVptr = X		//Mark pos. of 1st non-blank in group
	  while (X le TV!0) & (TV!X ne $ ) do X = X+1
	  PV!(PVptr+1) = X-PV!PVptr; PVptr = PVptr+2
	]
	let Ngrps = Min(PVptr rshift 1,Form!0)
// Zero initial missing groups
	let Field = vec ValSize
	let FormX = ((Form!0-Ngrps) lshift 1)+1
	Zero(Field,ValSize); Zero(CDVec,ValSize)
// Evaluate and store groups with text
	let TempTV = vec 80
	PVptr = PVptr-(Ngrps lshift 1)
	for I = Form!0-Ngrps+1 to Form!0 do
	[ let Size = PV!(PVptr+1)
	  TempTV!0 = Size
	  MBlock(TempTV+1,TV+PV!PVptr,Size)
	  unless SimpleTexttoDVec(TempTV,Form!(FormX+1),Field,Radix) do
		resultis false
	  MoveLongField(Field,0,Form!(FormX+1),CDVec,Form!FormX)
	  FormX = FormX+2; PVptr = PVptr+2
	]
	MBlock(DVec,CDVec,ValSize); resultis true
]


//DataToStream(..) outputs register and memory values to a stream using
//a format table from REGFORMS or MEMFORMS.  If Form is 0, then a
//left-justified octal string is printed.  If non-0, it points at a format
//table (see D1Tables.asm for description).

//Note:  Leading blanks must be suppressed for mmprgn.bcpl

and DataToStream(S,Form,Width,DVec,Radix; numargs NA) be
[	if NA < 5 then Radix = DefRadix
	test Form eq 0
	ifso DWns(S,DVec,Width,0,Radix)
	ifnot
	[ let flush0,Foo = 0,Form!0+Form!0-1
	  for FormX = 1 to Foo by 2 do
	  [ let NBits = Form!(FormX+1)
	    let Width = nil
	    test flush0 eq 0
	    ifso Width = (FormX eq Foo) & 1
	    ifnot
	    [ Width = selecton Radix into
		[ case 16: (NBits+3)/4
		  case 8:  (NBits+2)/3
		  case 10: table [	//***Just approximate
			1;  1;  1;  2;  2;  2;  3;  3
			3;  4;  4;  4;  4;  5;  5;  5
			6;  6;  6;  7;  7;  7;  7;  8
			8;  8;  9;  9;  9; 10; 10; 10
			] ! NBits
		]
	      Puts(S,$ )
	    ]
	    flush0 = DWns(S,DVec,NBits,Form!FormX,Radix,Width,flush0)
	  ]
	]
]

//DWns prints NBits from DVec starting at DBit1.

//Negative radix means print as a signed number.
//flush0 is $  for leading blanks or $0 for leading zeroes or 0 for
//no leading fill and no-print on 0.  If the Width argument is provided,
//at least that many characters will be printed.  Resultis the original
//flush0 if number is 0, 60B if non-0.
and DWns(S,DVec,NBits,DBit1,Radix,Width,flush0; numargs NA) = valof
[	let HNum,LNum,I = 0,0,nil
	DefaultArgs(lv NA,2,32,0,DefRadix,1,$*s)
	if NBits > 32 then MidasSwat(NBitsG32)
	let V,Sign = vec 32,0
//Setup double-precision number in HNum,LNum
	if Radix < 0 then if GetField(DBit1,1,DVec) ne 0 then
	[ HNum,LNum = -1,-1
	]
	MoveLongField(DVec,DBit1,NBits,lv HNum,32-NBits)
	if Radix < 0 do
	[  Radix,Width,Sign = -Radix,Width-1,$+
	  if HNum < 0 do
	  [ DoubleNeg(lv HNum); Sign = $-
	  ]
	]
	let Result = flush0
	if flush0 eq 0 then test (HNum ne 0) % (LNum ne 0) 
	  ifso Result = 60B
	  ifnot unless Width > 0 then resultis 0
//Radix is at 10,2; HNum,LNum,I at 14,2 15,2 and 16,2
	I = V
	(table [
//First loop until HNum < Radix
		#55001		//sta 3 1 2
		#155000		//mov 2 3
		#31410		//lda 2 10 3	Radix
		#25414		//lda 1 14 3	HNum
		#132032		//adcz# 1 2 szc	Skip if HNum ge Radix unsigned
		#414		//jmp .+14
		#102400		//sub 0 0
		#61021		//div		0_rem, 1_quo
		#77400		//swat		if nodiv
		#45414		//sta 1 14 3	HNum_quotient
		#25415		//lda 1 15 3	LNum
		#61021		//div
		#77400		//swat
		#45415		//sta 1 15 3	LNum_quotient
		#43416		//sta 0 @16 3	rv I = rem
		#11416		//isz 16 3	I = I+1
		#763		//jmp .-15
//Second loop until LNum eq 0
		#21414		//lda 0 14 3	HNum
		#25415		//lda 1 15 3	LNum
		#61021		//div
		#77400		//Swat
		#43416		//sta 0 @16 3
		#11416		//isz 16 3
		#102400		//sub 0 0
		#125014		//mov# 1 1 szr	Skip if quotient is 0
		#772		//jmp .-6
		#171000		//mov 3 2
		#35001		//lda 3 1 2
		#1401		//jmp 1 3
		] )()
	I = I-V
	RepPuts(S,flush0,Width-I)
	if Sign ne 0 then Puts(S,Sign)
	while I ne 0 do
	[ I = I-1; Puts (S,(V!I > 9 ? $A-10,$0)+V!I)
	]
	resultis Result
]


// Do numeric output to stream.
// Suppresses leading spaces if you tell it to, even if the radix is 8.
// Default Width=1, Radix=10, signed
and Wns(S,Num,Width,Radix; numargs NA) be
[	DefaultArgs(lv NA,-2,1,-10)
	DWns(S,lv Num,16,0,Radix,Width)
]