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 """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
 11 " This procedure enciphers an arrya of double words, i.e., fixed bin(71),
 12 " using the key that is provided.  It has entries to both encipher and decipher:
 13 "
 14 "         call encipher_(key,input_array,output_array,array_length)
 15 "
 16 "         call decipher_(key,input_array,output_array,array_length)
 17 "
 18 " where:  key                 is fixed bin(71) key for coding
 19 "         input_array(array_length) is fixed bin(71) array
 20 "         output_array(array_length) is fixed bin(71) array
 21 "         array_length        is fixed bin(17) length (double words) of array
 22 "
 23 "         Coded 1 April 1973 by Roger R. Schell, Major, USAF
 24 """""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
 25 
 26           entry     encipher_
 27           entry     decipher_
 28 
 29           equ       key,2
 30           equ       input_array,4
 31           equ       output_array,6
 32           equ       array_length,8
 33 
 34 "
 35 "         Entry to encipher
 36 "
 37 
 38 encipher_:
 39           push
 40           epplp     ap|output_array,*   "LP -> cipher text
 41           tra       setup_keys
 42 
 43 "
 44 "         Entry to decipher
 45 "
 46 
 47 decipher_:
 48           push
 49           epplp     ap|input_array,*    "set LP -> cipher text
 50 
 51 setup_keys:
 52                                         "First create internal keying variables
 53 "Use Tausworth pseudo-random number generator on key
 54 
 55           equ       shift,11            "Shift for generator
 56           equ       size,36             "Word size used for generator
 57 
 58           tempd     variables(12)       "Internal keying variables
 59 
 60           eax6      0                   "loop index in x6
 61           ldaq      ap|key,*            "Start with input key
 62 
 63 mask_loop:
 64                                         "Create masks
 65           staq      variables,6         "save copy of generator seed
 66           qrl       shift               "Now generate pseudo-random number
 67           arl       shift
 68           eraq      variables,6
 69           staq      variables,6
 70           qls       size-shift
 71           als       size-shift
 72           eraq      variables,6
 73           staq      variables,6         "Save result
 74 
 75           eax6      2,6
 76           cmpx6     18,du               "Generate 9 double words
 77           tnz       mask_loop
 78 
 79 "
 80 "Next create 7-bit shift variables
 81 
 82           eax6      0
 83           lrl       11                  "First 7 bits to upper A-reg
 84           eax0      0                   "Zero for clearing half word
 85 shift_loop:
 86           sta       variables+A1,6      "Upper A-reg is shift variable
 87           sxl0      variables+A1,6      "Zero lower half word
 88           lls       7
 89           ana       =o000177777777      "Save 7 bits in upper A-reg
 90           eax6      1,6
 91           cmpx6     7,du                "Generate 7 shift variables
 92           tnz       shift_loop
 93 
 94 "
 95 "         Now that we have needed variables, aply the cipher
 96 "
 97 
 98 "Declaration of offsets of keying variables
 99           equ       C0,0                "Initial cipher text from key
100           equ       M1,2                "Mask variables
101           equ       M2,4
102           equ       M3,6
103           equ       M4,8
104           equ       M5,10
105           equ       M6,12
106           equ       M7,14
107           equ       A1,16               "Amount of shift -- as address
108           equ       A2,17
109           equ       A3,18
110           equ       A4,19
111           equ       A5,20
112           equ       A6,21
113           equ       A7,22
114 
115           lxl5      ap|array_length,*   "Get length (double words)
116           eax5      -1,5                "Check for zero or negative
117           tmi       return
118           eax6      0                   "X6 is index into arrays
119           eppbp     variables+C0        "Initial cipher text from key
120 cipher_loop:
121           ldaq      bp|0
122 
123 "First compute select function
124 
125           llr       variables+A6,*
126           adlaq     variables+M6
127           llr       variables+A7,*
128           eraq      variables+M7
129           eax1      0,ql                "Save select function
130 "
131 "Compute value
132 "
133           ldaq      bp|0
134           llr       variables+A1,*
135           adlaq     variables+M1
136           canx1     =o10,du
137           tnz       2,ic
138           llr       variables+A2,*
139           eraq      variables+M2
140           canx1     =o4,du
141           tnz       2,ic
142           llr       variables+A3,*
143           adlaq     variables+M3
144           canx1     =o2,du
145           tnz       2,ic
146           llr       variables+A4,*
147           eraq      variables+M4
148           canx1     =o1,du
149           tnz       2,ic
150           llr       variables+A5,*
151           adlaq     variables+M5        "AQ contains computed key
152 
153           eppbp     lp|0,6              "set BP -> next cipher text autokey
154           eraq      ap|input_array,*6
155           staq      ap|output_array,*6  "return ciphered value
156           eax6      2,6                 "Increment array offset
157           eax5      -1,5                "Check for end of array
158           tpl       cipher_loop
159 return:
160 "
161 "Clean up the 'dirty blackboard' before returning
162 
163           bool      rpt,5202            "RPT instruction
164 
165           ldaq      *                   " Load AQ with garbage
166           eax6      0
167           vfd       8/11,2/0,1/1,7/0,12/rpt,6/2 "RPT instruction
168           staq      variables,6         "Overwrite keying variables
169 
170           return
171 
172           end