1 " ***********************************************************
 2 " *                                                         *
 3 " * Copyright, (C) Honeywell Information Systems Inc., 1982 *
 4 " *                                                         *
 5 " * Copyright (c) 1972 by Massachusetts Institute of        *
 6 " * Technology and Honeywell Information Systems, Inc.      *
 7 " *                                                         *
 8 " ***********************************************************
 9 
10 " quick binary to decimal conversion program for v2pl1
11 " Barry L. Wolman, 17 May 1973
12 "
13 "         dcl bindec entry(fixed bin) returns(char(12) aligned)
14 "         y = bindec(x)
15 "
16 "         dcl bindec$vs entry(fixed bin) returns(char(12) varying)
17 "         z = bindec$vs(x)
18 "
19           entry     bindec
20           entry     vs
21 
22           equ       t,56                in stack frame of caller!!!
23 "
24           bool      blank,040
25 
26           include   eis_micro_ops
27 
28 bindec:   epp2      0|2,*               get ptr to x
29           btd       (pr),(pr)           convert to decimal
30           desc9a    2|0,4
31           desc9ls   6|t,12
32           epp2      0|4,*               get ptr to y
33           mvne      (pr),(),(pr)                  move into y with editing
34           desc9ls   6|t,12
35           vfd       18/edit,18/5
36           desc9a    2|0,12
37           short_return
38 "
39 vs:       epp2      0|2,*               get ptr to x
40           btd       (pr),(pr)           and convert
41           desc9a    2|0,4
42           desc9ls   6|t,12
43           epp2      0|4,*               get ptr to z
44           mvne      (pr),(),(pr)        move into t(pr)get with editing
45           desc9ls   6|t,12
46           vfd       18/edit,18/5
47           desc9a    2|0,12
48           scmr      (pr),(du)           scan from right for blank
49           desc9a    2|0,12
50           vfd       o9/040
51           arg       6|t
52           ttn       no_blanks
53           ldq       6|t                 get number non-blank characters
54           stq       2|-1                set length of varying string
55           lda       12,dl               compute number of leading blanks
56           sba       6|t
57           mlr       (pr,rl,al),(pr,rl)  eliminate leading blanks
58           desc9a    2|0,ql
59           desc9a    2|0,ql
60           short_return
61 "
62 no_blanks:
63           lda       12,dl
64           sta       2|-1
65           short_return
66 "
67 edit:     vfd       9/lte+3,o9/blank,9/mfls+10,9/enf,9/mvc+1
68           end