3619 lines
119 KiB
Plaintext
3619 lines
119 KiB
Plaintext
1 /**** FOCAL 5/69 ****
|
||
2 /E.A.TAFT - REVISION OF FOCALW 8/68 /EAT/ 25-JUL-72
|
||
3
|
||
4
|
||
5
|
||
6
|
||
7
|
||
8 /ASSEMBLY INSTRUCTIONS FOR DECUS VERSION:
|
||
9
|
||
10 /INPUT FILES:
|
||
11 / FOCAL.569 FOCAL LANGUAGE PROCESSOR
|
||
12 / FLOAT.569 FLOATING POINT PACKAGE
|
||
13 / EXTEND.569 EXTENDED FUNCTION PACKAGE
|
||
14 / 2USER.569 2-USER OVERLAY
|
||
15
|
||
16 /ASSEMBLY USING PAL10 V.141
|
||
17 / .R PAL10
|
||
18 / *FOCAL.BIN_FOCAL.569,FLOAT.569
|
||
19 / *EXTEND.BIN_EXTEND.569
|
||
20 / *2USER.BIN_2USER.569
|
||
21 / *^C
|
||
22 / .R PIP
|
||
23 / *FOCAL.BIN/B_FOCCAL.BIN,EXTEND.BIN,2USER.BIN
|
||
24 / *PTP:/I_FOCAL.BIN
|
||
25
|
||
26 /WHEN READ-IN ON A PDP-8, THE LOADER WILL STOP 3 TIMES. THE FIRST
|
||
27 / SECTION CONTAINS THE BASIC PROCESSOR AND FLOATING POINT PACKAGE.
|
||
28 / THE SECOND SECTION CONTAINS THE EXTENDED FUNCTIONS. THE LAST
|
||
29 / SECTION CONTAINS THE 2-USER OVERLAY (REQUIRES 2 TERMINALS AND 8K).
|
||
30
|
||
31 /PROCESSOR INSTRUCTIONS
|
||
32 /FIXMRI AND=0000
|
||
33 /FIXMRI TAD=1000
|
||
34 /FIXMRI ISZ=2000
|
||
35 /FIXMRI DCA=3000
|
||
36 /FIXMRI JMS=4000
|
||
37 /FIXMRI JMP=5000
|
||
38 /FLOATING POINT INSTRUCTIONS
|
||
39 FIXMRI FPW=0000
|
||
40 FIXMRI FAD=1000
|
||
41 FIXMRI FSB=2000
|
||
42 FIXMRI FMY=3000
|
||
43 FIXMRI FDV=4000
|
||
44 FIXMRI FGT=5000
|
||
45 FIXMRI FPT=6000
|
||
46
|
||
47 FNR=7000
|
||
48 FEXT=0
|
||
49 FENT=JMS I 7
|
||
50 NOP=7000
|
||
51 CLA=7200
|
||
52 CLL=7100
|
||
53 CMA=7040
|
||
54 RAL=7004
|
||
55 CML=7020
|
||
56 RAR=7010
|
||
57 RTR=7012
|
||
58 RTL=7006
|
||
59 IAC=7001
|
||
60 SMA=7500
|
||
61 SZA=7440
|
||
62 SPA=7510
|
||
63 SNA=7450
|
||
64 SNL=7420
|
||
65 SZL=7430
|
||
66 SKP=7410
|
||
67 CIA=7041
|
||
68 ION=6001
|
||
69 IOF=6002
|
||
70 KSF=6031
|
||
71 KRB=6036
|
||
72 TSF=6041
|
||
73 TCF=6042
|
||
74 TPC=6044
|
||
75 TLS=6046
|
||
76 RSF=6011
|
||
77 RRB=6012
|
||
78 RFC=6014
|
||
79
|
||
80 / * FOCAL * - BY RICK MERRILL - FOR THE FAMILY OF 8.
|
||
81 /REVISED BY EDWARD TAFT 5/69
|
||
82
|
||
83 /MISCELLANEOUS ITEMS
|
||
84 *1
|
||
85 00001 5402 JMP I .+1 /INTERRUPT PROCESSOR ENTRY
|
||
86 00002 2603 INTRPT
|
||
87 00003 7477 MINUSA, -301 /CONSTANT
|
||
88 00004 0000 FNEGSW, 0 /USED FOR CALCULATING SIGNS
|
||
89 00005 0013 P13, 13 /CONSTANT
|
||
90 00006 0100 C100, 100 /CONSTANT
|
||
91 00007 6600 FPNT /ADDRESS OF FLOATING POINT INTERPRETER.
|
||
92
|
||
93 /AUTO-INDEX REGISTERS
|
||
94
|
||
95 00010 0000 AXIN, 0 /STORAGE INDEX
|
||
96 00011 0000 XRT, 0 /EXTRA XR
|
||
97 00012 0000 XRT2, 0 /EXTRA XR
|
||
98 00013 0000 PDLXR, 0 /PUSHDOWN LIST INDEX REGISTER.
|
||
99 00014 3377 FLTXR, IOBUF-1 /XR15 FOR FLOATING POINT
|
||
100 00015 0200 C200, 200 /CONSTANT
|
||
101 00016 0000 XRT3, 0 /USED BY PUSHDOWN LIST CONTROLS
|
||
102
|
||
103
|
||
104 TEXTP=. /TEXT POINTERS
|
||
105 00017 3430 AXOUT, FRSTX /OUTPUT INDEX
|
||
106 00020 0000 XCT, 0 /UNPACK SWITCH
|
||
107 00021 0000 GTEM, 0 /UNPACK STORAGE
|
||
108
|
||
109 /NUMBERS
|
||
110
|
||
111 00022 0256 PER, 256 /PERIOD
|
||
112 00023 7701 M77, -77 /RIGHT MASK
|
||
113 00024 7600 P7600, 7600 /GROUP MASK
|
||
114 00025 7760 M20, -20 /CONSTANT
|
||
115 00026 0177 P177, 177 /STEP MASK
|
||
116 00027 5577 BOTTOM, DBCONV-1/END OF TEXT BUFFER
|
||
117 FLOAT= JMS I . /FLOAT C(AC) SUBROUTINE
|
||
118 00030 7332 XFLOAT
|
||
119 00031 0017 P17, 17 /BCD MASK
|
||
120 00032 0277 P277, 277 /"?"
|
||
121 00033 0240 C240, 240 /SPACE
|
||
122 00034 7776 M2, -2 /CONSTANT
|
||
123 00035 0002 P2, 2 /CONSTANT
|
||
124 00036 0260 C260, 260 /ASCII FOR ZERO
|
||
125 00037 0000 HINBUF, 0 /HIGH SPEED INPUT BUFFER
|
||
126
|
||
127 FLOP=. /FLOATING OPERAND STORAGE
|
||
128 00040 0000 FLOP0, 0
|
||
129 00041 0000 FLOP1, 0
|
||
130 00042 0000 FLOP2, 0
|
||
131 00043 0000 FLOP3, 0
|
||
132 FLAC=. /FLOATING POINT ACCUMULATOR
|
||
133 00044 0000 FLAC0, 0
|
||
134 00045 0000 FLAC1, 0
|
||
135 00046 0000 FLAC2, 0
|
||
136 00047 0000 FLAC3, 0
|
||
137 NEGATE= JMS I . /NEGATE FLAC ROUTINE
|
||
138 00050 6676 NEGAC
|
||
139 00051 0010 TOTDIG, 10 /TOTAL DIGITS IN OUTPUT FIELD
|
||
140 FIX= JMS I . /FIX FLAC ROUTINE
|
||
141 00052 7311 XFIX
|
||
142 00053 0000 TABCTR, 0 /CARRIAGE INDEX
|
||
143
|
||
144 /CONSTANTS
|
||
145
|
||
146
|
||
147 LIST6=. /INPUT LIST FOR "SFOUND".
|
||
148 00054 0337 P337, 337 /LEFT ARR
|
||
149 00055 0214 214 /F.F.
|
||
150 00056 0207 207 /BELL
|
||
151 00057 0212 CLF, 212 /L.F.
|
||
152 LIST3=. /EXCRETION LIST
|
||
153 00060 0215 CCR, 215 /LIST BRANCHER.
|
||
154 00061 0000 0 /SEARCH CHARACTER (VARIABLE)
|
||
155
|
||
156 M100=.
|
||
157 00062 7700 P7700, 7700 /LEFT MASK
|
||
158 00063 7540 M240, -240 /SPACE TEST
|
||
159 00064 7522 MPER, -256 /PERIOD TEST
|
||
160 00065 7563 MCR, -215 /C.R. TEST
|
||
161 MFLT=. /3-WORD FLOATING POINT
|
||
162 00066 7775 M3, -3
|
||
163 00067 7773 M5, -5 /PAREN TEST
|
||
164 00070 7767 M11, -11 /PAREN TEST
|
||
165 00071 0077 P77, 77 /RIGHT MASK
|
||
166
|
||
167 00072 6170 FOUTPUT,BDCONV /FLOATING OUTPUT
|
||
168 00073 5600 FINPUT, DBCONV /FLOATING INPUT
|
||
169 00074 2527 COMBUF, COMEIN /COMMAND BUFFER`START
|
||
170 00075 3420 CFRS, FRST /ADDRESS OF DUMMY LINE.
|
||
171 00076 3432 END, BUFBEG /FIRST LOCATION USED.
|
||
172 00077 3432 ENDT, BUFBEG /START OF STORAGE AREA **
|
||
173 RETURN= JMP I . /FUNCTION RETURN
|
||
174 00100 2056 EFUN3I, EFUN3
|
||
175
|
||
176 /NEW INSTRUCTIONS:
|
||
177
|
||
178 PUSHJ=JMS I . /RECURSIVE SUBROUTINE CALL
|
||
179 00101 0523 XPUSHJ
|
||
180 POPA=TAD I PDLXR/RESTORE AC
|
||
181 POPJ=JMP I . /SUBROUTINE RETURN
|
||
182 00102 1556 XPOPJ
|
||
183 PUSHA=JMS I . /SAVE AC
|
||
184 00103 0501 XPUSHA
|
||
185 PUSHF=JMS I . /SAVE GROUP OF DATA
|
||
186 00104 0532 PD2
|
||
187 POPF=JMS I . /RESTORE GROUP
|
||
188 00105 0550 PD3
|
||
189 GETC=JMS I . /UNPACK A CHARACTER
|
||
190 00106 2315 UTRA
|
||
191 PACKC=JMS I . /PACK A CHARACTER
|
||
192 00107 3023 PACBUF
|
||
193 SORTJ=JMS I . /SORT AND BRANCH ON AC OR CHAR
|
||
194 00110 1333 SORTB
|
||
195 SORTC=JMS I . /SORT CHAR
|
||
196 00111 0733 XSORTC
|
||
197 PRINTC=JMS I . /PRINT AC OR CHAR
|
||
198 00112 2477 OUT
|
||
199 READC=JMS I . /READ ASR-33 INTO CHAR AND PRINT IT
|
||
200 00113 2463 CHIN
|
||
201 PRNTLN=JMS I . /PRINT C(LINENO)
|
||
202 00114 6151 XPRNTL
|
||
203 GETLN=JMS I . /UNPACK AND FORM A LINENUMBER
|
||
204 00115 0312 XGETLN
|
||
205 FINDLN=JMS I . /SEARCH FOR A GIVEN LINE
|
||
206 00116 2265 XFIND
|
||
207 ENDLN=JMS I . /INSERT LINE POINTERS
|
||
208 00117 2417 XENDLN
|
||
209 RTL6=JMS I . /ROTATE LEFT SIX
|
||
210 00120 0305 XRTL6
|
||
211 SPNOR=JMS I . /IGNORE SPACES AND LEADING ZEROS
|
||
212 00121 1524 XSPNOR
|
||
213 TESTN=JMS I . /PERIOD; OTHER; NUMBER
|
||
214 00122 1533 XTESTN
|
||
215 TSTLPR=JMS I . /SKIP IF 5<SORTCN<= 11 (I.E. AN L-PAR)
|
||
216 00123 2077 LPRTST
|
||
217 TSTGRP=JMS I . /SKIP IF G(AC) = G(LINENO)
|
||
218 00124 2451 GRPTST
|
||
219 TESTC=JMS I . /TERM; NUMBER; FUNCTION; LETTER
|
||
220 00125 0713 XTESTC
|
||
221 ERROR=JMS I . /GENERAL ERROR ROUTINE
|
||
222 00126 2736 ERR2
|
||
223
|
||
224
|
||
225 00127 0000 SORTCN, 0 /NUMBER IN TABLE`FROM SORTC
|
||
226 00130 0000 LASTOP, 0 /LAST OPERATION FOR EVAL
|
||
227 EFOP=. /FUNCTION CODE.
|
||
228 00131 0000 ATSW, 0 /ASK-TYPE SWITCH
|
||
229 00132 7760 CNTR, -20 /DELETE AND ERROR COUNTER(USED BY F.P. ALSO)
|
||
230
|
||
231 00133 0004 DECP, 4 /NUMBER OF DECIMAL POINTS
|
||
232
|
||
233 STARTV=. /=END FOR 8K
|
||
234
|
||
235 00134 3432 BUFR, BUFBEG /NEXT LOCATION IN BUFFER = LAST LOCATION OF TEXT.
|
||
236
|
||
237 00135 0000 ADD, 0 /CHAR BUF INPUT
|
||
238 00136 0000 XCTIN, 0 /PACK SWITCH
|
||
239 00137 2675 OUTDEV, XOUTL /OUTPUT SUBROUTINE
|
||
240 00140 2665 INDEV, XI33 /INPUT SUBROUTINE
|
||
241
|
||
242 00141 0001 NAGSW, 0001 /NOT ALL AND/OR GROUP SWITCH (4000=ONE;1=ALL;0=GROUP)
|
||
243 00142 0215 CHAR, 215 /THE MOST IMPORTANT REGISTER
|
||
244 00143 0000 LINENO, 0000 /LINE NUMBER READ BY GETLN
|
||
245 00144 0005 GINC, 5 /WORDS TO STORE 1 VARIABLE
|
||
246
|
||
247 00145 1575 PC, FLTZER /PROGRAM COUNTER
|
||
248 00146 0000 THISLN, 0 /LINE POINTER FROM 'FINDLN'
|
||
249 00147 0000 THISOP, 0 /CURRENT 'EVAL' OPERATION
|
||
250 00150 0000 LASTLN, 0 /BACK POINTER FROM 'FINDLN'
|
||
251 00151 0001 DEBGSW, 1 /DEBUG SWITCH ; NON-ZERO FOR LITERAL.
|
||
252 00152 0001 DMPSW, 1 /=0 FOR TRACE ON.
|
||
253 00153 0000 PACKST, 0 /RUBOUT PROTECTION
|
||
254 00154 0000 PT1, 0 /VARIABLE POINTER
|
||
255 00155 3432 LASTV, BUFBEG /ADDRESS OF LAST VARIABLE
|
||
256 00156 0000 T1, 0 /TEMPORARY REGISTER - MAIN
|
||
257 00157 0000 T2, 0 /TEMP REGISTER - FOR NEW INST. ROUTINES.
|
||
258 00160 2034 FLARGP, FLARG /DATA ADDRESS
|
||
259 00161 2463 PTCH, CHIN /GENERAL CHARACTER INPUT ROUTINE.
|
||
260 /USED BY NEW FLOATING PT. PACKAGE
|
||
261 00162 0000 TEMP1, 0
|
||
262 00163 0000 TEMP2, 0
|
||
263 00164 0000 TEMP3, 0
|
||
264 TSTERM= JMS I . /TEST FOR ,;CR
|
||
265 00165 2514 XTSTER /RETURNS: OTHER, ; OR CR, COMMA
|
||
266 DIGITS=6 /SIGNIFICANT DIGITS
|
||
267 /FOCAL'S COMMAND/INPUT DRIVER
|
||
268
|
||
269 *176
|
||
270 00176 3432 BEGIN /(RECOVR+1 AFTER INITIALIZATION)
|
||
271 00177 7610 START, SKP CLA /PROGRAM START FROM SELF
|
||
272 00200 5576 JMP I .-2 /CONSOLE START: SW=200.
|
||
273 00201 1227 TAD CFRSX /(PC) => 0
|
||
274 00202 3145 DCA PC /FOR COMMAND MODE
|
||
275 00203 3151 DCA DEBGSW /ENABLE TRACE FOR INPUT OF (?).
|
||
276 00204 1226 TAD COMBOT /PROTECT COMMAND BUFFER.
|
||
277 00205 3013 DCA PDLXR /NO PATCH TEST.
|
||
278 00206 2152 ISZ DMPSW /INIT UNPACK AND TRACE SWITCH.
|
||
279 00207 3061 DCA LIST3+1 /CLEAR SEARCH CHARACTER FOR INPUT.
|
||
280 00210 1054 TAD P337 /ANNOUNCE PRESENCE
|
||
281 00211 4512 PRINTC /BY TYPING THE LEAD-IN CHARACTER
|
||
282 00212 1074 IBAR, TAD COMBUF /INITIALIZE COMMAND BUFFER
|
||
283 00213 3010 DCA AXIN /FOR UNPACKING.
|
||
284 00214 3136 DCA XCTIN
|
||
285 00215 1074 TAD COMBUF /RUBOUT PROTECTION
|
||
286 00216 3153 DCA PACKST
|
||
287 00217 4513 IGNOR, READC /READ COMMAND STRING
|
||
288 00220 4510 SORTJ
|
||
289 00221 0053 LIST6-1
|
||
290 00222 0510 INLIST-LIST6
|
||
291 00223 4507 PACKC /SAVE STRING CHARACTER.
|
||
292 00224 5217 JMP IGNOR
|
||
293 /////
|
||
294 00225 4000 P4000, 4000 /LINE NUMBER TEST
|
||
295 00226 2612 COMBOT, COMOUT+12 /END OF COMMAND BUFFER,LESS PROTECTION COUNT.
|
||
296 00227 1575 CFRSX, FLTZER /POINTER FOR PC=COMMAND OR INPUT
|
||
297 /////
|
||
298 /COMMAND/INPUT PROCESSOR
|
||
299
|
||
300 00230 4507 IRETN, PACKC /START TO PACK C.R.
|
||
301 00231 4507 PACKC /FINISH C.R.
|
||
302 00232 1074 TAD COMBUF /INITIALIZE "TEXTP"
|
||
303 00233 3017 GONE, DCA AXOUT /SETUP CURRENT LINE
|
||
304 00234 3020 DCA XCT
|
||
305 00235 4506 GETC /READ FIRST CHARACTER.
|
||
306 00236 1027 TAD BOTTOM /INIT PUSH-DOWN-LIST
|
||
307 00237 3013 DCA PDLXR
|
||
308 00240 4521 SPNOR /IGNORE LEADING BLANKS
|
||
309 00241 4522 TESTN /DOES THE LINE BEGIN WITH 1-9?
|
||
310 00242 4526 ERROR4 /ILLEGAL GROUP ZERO USAGE
|
||
311 00243 5274 JMP INPUTX /NO
|
||
312 00244 6002 IOF /YES,STOP INPUT MOMENTARILY.
|
||
313 00245 2151 ISZ DEBGSW /DISABLE TRACE FOR REPACKING
|
||
314 00246 4515 GETLN /READ THIS LINE NUMBER
|
||
315 00247 1141 TAD NAGSW
|
||
316 00250 1225 TAD P4000 /TEST FOR SINGLE LINE
|
||
317 00251 7640 SZA CLA
|
||
318 00252 4526 ERROR3 /ILLEGAL LINE NUMBER ON INPUT
|
||
319 00253 1134 TAD BUFR /SET POINTERS
|
||
320 00254 3010 DCA AXIN
|
||
321 00255 3136 DCA XCTIN
|
||
322 00256 1143 TAD LINENO /SAVE LINE #
|
||
323 00257 3410 DCA I AXIN /(X-MEM)
|
||
324 00260 4521 SPNOR /IGNORE SPACES AFTER LINE NUMBER
|
||
325 00261 7410 SKP
|
||
326 00262 4506 GETC /READ 1ST AFTER LINENO TERMINATOR.
|
||
327 00263 4507 PACKC /SAVE TEXT AND RESTORE DATA FIELD
|
||
328 00264 1142 TAD CHAR /TEST FOR END OF INPUT STRING
|
||
329 00265 1065 TAD MCR
|
||
330 00266 7640 SZA CLA
|
||
331 00267 5262 JMP .-5
|
||
332 00270 4501 PUSHJ /REMOVE OLD LINE, IF ANY.
|
||
333 00271 2111 DELETE
|
||
334 00272 4517 ENDLN /INSERT NEW LINE
|
||
335 00273 5177 JMP START
|
||
336 /////
|
||
337 00274 4501 INPUTX, PUSHJ /PROCESS IMMEDIATE COMMAND.
|
||
338 00275 0616 PROC
|
||
339 00276 1545 TAD I PC /CHECK NEXT LINE (X-MEM)
|
||
340 00277 7450 SNA /END OF PROGRAM?
|
||
341 00300 5177 JMP START /YES
|
||
342 00301 3145 DCA PC /SAVE NEW LINE NO.
|
||
343 00302 1145 TAD PC /START NEW LINE
|
||
344 00303 7001 IAC
|
||
345 00304 5233 JMP GONE /PROCESS OTHER COMMANDS
|
||
346 /TEXT LINE BUFFER FORMAT*
|
||
347 /#1 : POINTER OR ZERO IN LAST
|
||
348 /#2 : LINENO
|
||
349 /#3 - #N+1 : TEXT
|
||
350 /#N : C.R.
|
||
351
|
||
352 00305 0000 XRTL6, 0 /ROTATE AC LEFT 6
|
||
353 00306 7106 CLL RTL
|
||
354 00307 7006 RTL
|
||
355 00310 7006 RTL
|
||
356 00311 5705 JMP I XRTL6
|
||
357 /
|
||
358 /PROCESS A LINE NUMBER - "GETLN"
|
||
359 00312 0000 XGETLN, 0
|
||
360 00313 4521 SPNOR
|
||
361 00314 1225 TAD P4000 /INITIALIZE TO SINGLE LINE
|
||
362 00315 3141 DCA NAGSW
|
||
363 00316 4511 SORTC /TEST FOR A SIGN
|
||
364 00317 6114 SNLIST-1
|
||
365 00320 5370 JMP EVLN /EVALUATE IN FLOATING POINT
|
||
366 00321 4766 JMS I INPINT /FIXED POINT: GET GROUP
|
||
367 00322 4522 TESTN
|
||
368 00323 4506 GETC /GO PAST . IF THERE
|
||
369 00324 4356 JMS GEG /GET 1ST STEP DIGIT
|
||
370 00325 7106 CLL RTL /MULTIPLY BY TEN
|
||
371 00326 1127 TAD SORTCN
|
||
372 00327 7004 RAL
|
||
373 00330 4356 JMS GEG /GET 2ND STEP DIGIT
|
||
374 00331 1143 TAD LINENO /COMBINE
|
||
375 00332 7450 GEXIT, SNA
|
||
376 00333 3141 DCA NAGSW /MUST BE GROUP
|
||
377 00334 3143 DCA LINENO /SAVE STEP NUMBER
|
||
378 00335 1164 TAD DECNUM /GROUP
|
||
379 00336 7450 SNA
|
||
380 00337 5347 JMP GTESTA /GROUP 0: MUST BE "ALL"
|
||
381 00340 4520 RTL6 /CONSTRUCT LINE NUMBER
|
||
382 00341 7004 RAL
|
||
383 00342 1143 TAD LINENO
|
||
384 00343 3143 DCA LINENO
|
||
385 00344 1164 TAD DECNUM /TEST FOR LEGAL GROUP
|
||
386 00345 0367 AND C7760
|
||
387 00346 5351 JMP .+3
|
||
388 00347 2141 GTESTA, ISZ NAGSW /SET TO "ALL"
|
||
389 00350 1143 TAD LINENO /MAKE SURE LINE # IS ZERO
|
||
390 00351 7650 SNA CLA
|
||
391 00352 4522 TESTN /OK, TEST FOR EXTRA DIGITS
|
||
392 00353 5361 JMP LNERR /DOUBLE ., ILLEGAL G. 0, OR G.>15
|
||
393 00354 5712 JMP I XGETLN /OK
|
||
394 00355 5361 JMP LNERR /TOO MANY DIGITS
|
||
395
|
||
396 00356 0000 GEG, 0 /GET A STEP DIGIT
|
||
397 00357 3143 DCA LINENO
|
||
398 00360 4522 TESTN
|
||
399 00361 4526 LNERR, ERROR /DOUBLE PERIODS
|
||
400 00362 5331 JMP GEXIT-1 /NO DIGIT
|
||
401 00363 4506 GETC /DIGIT, PASS IT
|
||
402 00364 1127 TAD SORTCN /EXIT WITH VALUE
|
||
403 00365 5756 JMP I GEG
|
||
404 /////
|
||
405 00366 6010 INPINT, DECINT
|
||
406 00367 7760 C7760, 7760
|
||
407 /////
|
||
408 /EVALUATE A LINE NUMBER IN FLOATING POINT
|
||
409 00370 4501 EVLN, PUSHJ /GET VALUE
|
||
410 00371 1601 EVAL
|
||
411 00372 4452 FIX /GET GROUP #
|
||
412 00373 4503 PUSHA
|
||
413 00374 1045 TAD FLAC1
|
||
414 00375 7640 SZA CLA
|
||
415 00376 5361 JMP LNERR /TOO BIG
|
||
416 00377 4407 FENT /GET STEP #
|
||
417 00400 7000 FNR
|
||
418 00401 2560 FSB I FLARGP /THIS GIVES -(FRACTIONAL PART)
|
||
419 00402 3614 FMY I F10P
|
||
420 00403 3614 FMY I F10P
|
||
421 00404 2615 FSB I FP10P /KILL ANY ROUNDOFF ERROR
|
||
422 00405 0000 FEXT
|
||
423 00406 4450 NEGATE
|
||
424 00407 1413 POPA /RESTORE GROUP
|
||
425 00410 3164 DCA DECNUM
|
||
426 00411 4452 FIX
|
||
427 00412 5613 JMP I .+1
|
||
428 00413 0332 GEXIT
|
||
429 /////
|
||
430 00414 5770 F10P, FLTEN
|
||
431 00415 5773 FP10P, FLPTEN
|
||
432
|
||
433 /RANGE OF ACCEPTIBLE LINE NUMBERS = 1.01 TO 15.99
|
||
434
|
||
435 /NAGSW:
|
||
436 /GROUP=0000
|
||
437 /LINE=4000
|
||
438 /ALL=0001
|
||
439 /RECURSIVE OPERATE, EXECUTE, OR CALL
|
||
440
|
||
441 00416 4515 DO, GETLN /EXECUTE ONE LINE, A GROUP,OR ALL
|
||
442 00417 1145 TAD PC /SAVE ADDRESS
|
||
443 00420 4503 PUSHA /OF CURRENT LINE
|
||
444 00421 4504 PUSHF /SAVE REST OF THIS LINE
|
||
445 00422 0017 TEXTP /ADDRESS OF TEXT POINTERS
|
||
446 00423 4504 DGRP, PUSHF /SAVE NAGSW; CHAR; AND LINENO.
|
||
447 00424 0141 NAGSW
|
||
448 00425 1141 TAD NAGSW /CHECK DATA FROM GETLN.
|
||
449 00426 7710 SPA CLA /SKIP IF GROUP OR ALL
|
||
450 00427 5254 JMP DOONE /DO ONE LINE
|
||
451 00430 4516 FINDLN /INIT FOR GROUP AND SET THISLN
|
||
452 00431 5273 JMP TGRP2
|
||
453 00432 4501 DGRP1, PUSHJ /EXECUTE OBJECT LINE AND SET PC.
|
||
454 00433 0613 PROCESS-2
|
||
455 00434 4505 POPF /RESTORE THE DATA
|
||
456 00435 0141 NAGSW
|
||
457 00436 1545 TAD I PC /CHECK FOR END OF TEXT (X-MEM)
|
||
458 00437 7450 SNA
|
||
459 00440 5262 JMP DCONT /ALL DONE
|
||
460 00441 7001 IAC
|
||
461 00442 3154 DCA PT1 /SAVE POINTER TO LINENO
|
||
462 00443 1141 TAD NAGSW /CHECK FOR GROUP
|
||
463 00444 7740 SMA SZA CLA
|
||
464 00445 5251 JMP .+4 /DO ALL
|
||
465 00446 1554 TAD I PT1 /TEST GROUP (X-MEM)
|
||
466 00447 4524 TSTGRP
|
||
467 00450 5262 JMP DCONT /NOT IN GROUP
|
||
468 00451 1554 TAD I PT1 /READ NEXT LINE NO. (X-MEM)
|
||
469 00452 3143 DCA LINENO
|
||
470 00453 5223 JMP DGRP /CONTINUE THE SUBROUTINE
|
||
471 /////
|
||
472 00454 4516 DOONE, FINDLN /FIND THE LINE
|
||
473 00455 4526 ERROR2 /NO SUCH LINE NUMBER
|
||
474 00456 4501 PUSHJ /EXECUTE IT
|
||
475 00457 0615 PROCESS
|
||
476 00460 4505 POPF /RESTORE CHAR
|
||
477 00461 0141 NAGSW
|
||
478 00462 4505 DCONT, POPF /RESTORE TEXT POINTERS
|
||
479 00463 0017 TEXTP
|
||
480 00464 1413 POPA /RESTORE ADDRESS OF CURRENT LINE.
|
||
481 00465 3145 DCA PC
|
||
482 00466 4565 TSTERM /GO TO TERMINATOR
|
||
483 00467 5266 JMP .-1
|
||
484 00470 5672 JMP I .+2 /END OF DO, CONTINUE PROCESSING
|
||
485 00471 5216 JMP DO /COMMA, DO ANOTHER
|
||
486 00472 0616 PROC
|
||
487
|
||
488 00473 1146 TGRP2, TAD THISLN /TEST FOR GOOD GROUP NUMBER.
|
||
489 00474 3011 DCA XRT
|
||
490 00475 1411 TAD I XRT
|
||
491 00476 4524 TSTGRP
|
||
492 00477 4526 ERROR2 /NO SUCH GROUP NUMBER
|
||
493 00500 5232 JMP DGRP1
|
||
494 /PUSHDOWN LIST CONTROLS
|
||
495 /
|
||
496 00501 0000 XPUSHA, 0 /PUSHDOWN THE AC - "PUSHA"
|
||
497 00502 3332 DCA PD2 /SAVE AC
|
||
498 00503 7040 CMA /BACK UP POINTER
|
||
499 00504 4310 JMS PCHK /CHECK CORE USAGE
|
||
500 00505 1332 TAD PD2
|
||
501 00506 3416 DCA I XRT3 /SAVE
|
||
502 00507 5701 JMP I XPUSHA
|
||
503 /////
|
||
504 00510 0000 PCHK, 0
|
||
505 00511 1013 TAD PDLXR /INC IN AC
|
||
506 00512 3013 DCA PDLXR
|
||
507 00513 1013 TAD PDLXR
|
||
508 00514 3016 DCA XRT3 /DUPLICATE POINTER
|
||
509 00515 1013 TAD PDLXR
|
||
510 00516 7141 CLL CIA
|
||
511 00517 1155 TAD LASTV
|
||
512 00520 7630 SZL CLA
|
||
513 00521 4526 ERROR /STORAGE FILLED BY PUSHDOWN LIST
|
||
514 00522 5710 JMP I PCHK
|
||
515 /////
|
||
516 00523 0000 XPUSHJ, 0 /RECURSIVE SUBROUTINE CALL - "PUSHJ"
|
||
517 00524 7201 CLA IAC
|
||
518 00525 1323 TAD XPUSHJ /SAVE RETURN
|
||
519 00526 4301 JMS XPUSHA /(PUSHA)
|
||
520 00527 1723 TAD I XPUSHJ /TO NEW ROUTINE
|
||
521 00530 3323 DCA XPUSHJ
|
||
522 00531 5723 JMP I XPUSHJ
|
||
523 /////
|
||
524 00532 0000 PD2, 0 /SAVE A FLOATING PT NUMBER - "PUSHF"
|
||
525 00533 7240 CLA CMA /COMPUTE ADDRESS
|
||
526 00534 1732 TAD I PD2
|
||
527 00535 3011 DCA XRT
|
||
528 00536 2332 ISZ PD2
|
||
529 00537 1066 TAD M3 /BACKUP THREE
|
||
530 00540 4310 JMS PCHK
|
||
531 00541 1411 TAD I XRT /SAVE 3 WORDS
|
||
532 00542 3416 DCA I XRT3
|
||
533 00543 1411 TAD I XRT
|
||
534 00544 3416 DCA I XRT3
|
||
535 00545 1411 TAD I XRT
|
||
536 00546 3416 DCA I XRT3
|
||
537 00547 5732 JMP I PD2
|
||
538
|
||
539 00550 0000 PD3, 0 /RESTORE A FLOATING PT # - "POPF"
|
||
540 00551 7240 CLA CMA
|
||
541 00552 1750 TAD I PD3
|
||
542 00553 2350 ISZ PD3
|
||
543 00554 3011 DCA XRT
|
||
544 00555 1413 TAD I PDLXR
|
||
545 00556 3411 DCA I XRT
|
||
546 00557 1413 TAD I PDLXR
|
||
547 00560 3411 DCA I XRT
|
||
548 00561 1413 TAD I PDLXR
|
||
549 00562 3411 DCA I XRT
|
||
550 00563 5750 JMP I PD3
|
||
551 /
|
||
552 /INPUT CONTROL CHARACTERS
|
||
553 00564 0212 INLIST, IBAR /B.A.=RESTART
|
||
554 00565 0223 IGNOR+4 /F.F.
|
||
555 00566 0223 IGNOR+4 /BELL
|
||
556 00567 0217 IGNOR /L.F.=IGNORED
|
||
557 00570 0230 IRETN /C.R.=TERMINATE INPUT
|
||
558 /
|
||
559 /LIST OF FUNCTION ADDRESSES
|
||
560 00571 2053 FNTABF, XABS /ABSOLUTE VALUE
|
||
561 00572 7535 FSGN /SIGN PART
|
||
562 00573 1156 XINT /INTEGER PART
|
||
563 00574 1145 XDYS /FDIS- DISPLAY Y AND INTENSIFY
|
||
564 00575 7351 FRAN /RANDOM NUMBER
|
||
565 00576 1153 XDXS /SET X-COORDINATE FOR DISPLAY
|
||
566 00577 2414 XADC /READ ANALOG-DIGITAL CONVERTER
|
||
567 00600 2735 ERROR5 /ATN THESE ROUTINES NOT IN PACKAGE
|
||
568 00601 2735 ERROR5 /EXP
|
||
569 00602 2735 ERROR5 /LOG
|
||
570 00603 2735 ERROR5 /SIN
|
||
571 00604 2735 ERROR5 /COS
|
||
572 00605 7462 FSQT /SQUARE ROOT
|
||
573 00606 2735 ERROR5 /NEW- USER-DEFINED FUNCTION
|
||
574 /
|
||
575 00607 7472 MF, -306 /USED BY TESTC
|
||
576 /PRIMARY CONTROL AND TRANSFER
|
||
577
|
||
578 00610 4515 GOTO, GETLN /READ THE LINE NUMBER REQUESTED
|
||
579 00611 4516 FINDLN /LOCATE IT AND RESET TEXTP
|
||
580 00612 4526 ERROR2 /NOT THERE OR A TIGHT LOOP.
|
||
581 00613 1146 TAD THISLN /SET PC
|
||
582 00614 3145 DCA PC
|
||
583 00615 4506 PROCESS,GETC /TEST FOR END OF LINE
|
||
584 00616 4511 PROC, SORTC /FIRST CHARACTER READY = USE PROC
|
||
585 00617 0057 CCR-1
|
||
586 00620 5502 PC1, POPJ /EXIT "PROCESS"
|
||
587 00621 4511 SORTC /IGNORE SPACE ; ,
|
||
588 00622 1140 GLIST-1
|
||
589 00623 5215 JMP PROCESS
|
||
590 00624 1142 TAD CHAR /SAVE COMMAND CHARACTER
|
||
591 00625 4503 PUSHA
|
||
592 00626 4506 GETC /GO TO TERMINATOR
|
||
593 00627 4511 SORTC
|
||
594 00630 2002 TERMS-4
|
||
595 00631 7410 SKP
|
||
596 00632 5226 JMP .-4
|
||
597 00633 4521 SPNOR
|
||
598 00634 1413 POPA
|
||
599 00635 4510 SORTJ /GO DO COMMAND
|
||
600 00636 0755 COMLST-1
|
||
601 00637 0206 COMGO-COMLST
|
||
602 00640 4526 ERROR2 /ILLEGAL COMMAND
|
||
603 /////
|
||
604
|
||
605 COMMENTS=PC1 /ALSO IS CONTINUE
|
||
606
|
||
607 /OUTPUT COMMAND TEXT
|
||
608
|
||
609 00641 4711 WRITE, JMS I WTXS /SAVE CHAR AND TEXT POINTERS
|
||
610 00642 4515 GETLN /SET LINENO
|
||
611 00643 2151 ISZ DEBGSW /DISABLE TRACE
|
||
612 00644 4516 FINDLN /SEARCH FOR LINE NUMBER
|
||
613 00645 5274 JMP WTESTG /NOT THERE OR GROUP
|
||
614 00646 1143 TAD LINENO
|
||
615 00647 7640 SZA CLA
|
||
616 00650 4514 PRNTLN /PRINT LINE NUMBER AND A SPACE.
|
||
617 00651 4506 GETC
|
||
618 00652 4512 PRINTC /PRINT TEXT OF A LINE.
|
||
619 00653 1142 TAD CHAR
|
||
620 00654 1065 TAD MCR
|
||
621 00655 7640 SZA CLA /SKIP IF END OF LINE
|
||
622 00656 5251 JMP .-5
|
||
623 00657 1546 TAD I THISLN /TEST FOR END OF TEXT (X-MEM)
|
||
624 00660 7450 WTEST2, SNA
|
||
625 00661 5303 JMP WEXIT /WRITE FINISHED
|
||
626 00662 7001 IAC
|
||
627 00663 3154 DCA PT1 /SAVE POINTER TO LINENO OF`NEXT (X-MEM)
|
||
628 00664 1141 TAD NAGSW
|
||
629 00665 7700 SMA CLA
|
||
630 00666 1554 TAD I PT1 /(X-MEM)
|
||
631 00667 4524 TSTGRP /TRY NEXT LINENO FOR GROUP.
|
||
632 00670 5276 JMP WX
|
||
633 00671 1554 WALL, TAD I PT1 /SET LINENO (X-MEM)
|
||
634 00672 3143 DCA LINENO
|
||
635 00673 5244 JMP WRITE+3
|
||
636 ///
|
||
637 00674 1146 WTESTG, TAD THISLN /INIT GROUP PRINTOUT
|
||
638 00675 5260 JMP WTEST2
|
||
639 /////
|
||
640 00676 1141 WX, TAD NAGSW
|
||
641 00677 7750 SPA SNA CLA /SKIP IF ALL
|
||
642 00700 5303 JMP WEXIT
|
||
643 00701 4512 PRINTC /PRINT C.R. AGAIN
|
||
644 00702 5271 JMP WALL
|
||
645 /////
|
||
646 00703 4712 WEXIT, JMS I WTXR /RESTORE CURRENT LINE
|
||
647 00704 3151 DCA DEBGSW /RESTORE TRACE
|
||
648 00705 4565 TSTERM
|
||
649 00706 5305 JMP .-1
|
||
650 00707 5216 JMP PROC /END OF WRITE
|
||
651 00710 5241 JMP WRITE /COMMA, MORE TO WRITE
|
||
652 /////
|
||
653 00711 2435 WTXS, TXTSAV
|
||
654 00712 2443 WTXR, TXTRES
|
||
655
|
||
656 00713 0000 XTESTC, 0 /TEST THE NATURE OF THE NEXT ALPHANUMERIC - "TESTC"
|
||
657 00714 4521 SPNOR /IGNORE SPACES
|
||
658 00715 4511 SORTC /TEST THE VARIABLE TERMINATORS
|
||
659 00716 2005 TERMS-1
|
||
660 00717 5713 JMP I XTESTC /YES - SORTCN IS SET
|
||
661 00720 2313 ISZ XTESTC
|
||
662 00721 4522 TESTN
|
||
663 00722 5713 JMP I XTESTC /. (PART OF NUMBER)
|
||
664 00723 7410 SKP /OTHER
|
||
665 00724 5713 JMP I XTESTC /NUMBER
|
||
666 00725 1142 TAD CHAR /TEST FOR "F"
|
||
667 00726 1207 TAD MF
|
||
668 00727 7640 SZA CLA
|
||
669 00730 2313 ISZ XTESTC /NO
|
||
670 00731 2313 ISZ XTESTC /RETURNS:
|
||
671 00732 5713 JMP I XTESTC /TERMINATOR;NUMBER;FUNCTION;OTHER
|
||
672 /////
|
||
673 00733 0000 XSORTC, 0 /SORT CHAR AGAINST TABLE - "SORTC"
|
||
674 00734 1733 TAD I XSORTC
|
||
675 00735 3012 DCA XRT2 /1ST ARG IS LIST-1
|
||
676 00736 1412 TAD I XRT2
|
||
677 00737 7510 SPA /LIST IS ENDED BY A NEGATIVE NUMBER
|
||
678 00740 5352 JMP SEXC /2AND EXIT = NOT IN LIST
|
||
679 00741 7041 CIA
|
||
680 00742 1142 TAD CHAR
|
||
681 00743 7640 SZA CLA /COMPARE
|
||
682 00744 5336 JMP .-6
|
||
683 00745 1733 TAD I XSORTC /COMPUTE INCREMENT : 0 - N
|
||
684 00746 7040 CMA
|
||
685 00747 1012 TAD XRT2
|
||
686 00750 3127 DCA SORTCN
|
||
687 00751 7410 SKP /1ST EXIT = YES
|
||
688 00752 2333 SEXC, ISZ XSORTC
|
||
689 00753 2333 ISZ XSORTC
|
||
690 00754 7300 CLA CLL
|
||
691 00755 5733 JMP I XSORTC
|
||
692
|
||
693 /COMMAND DECODING LIST
|
||
694 00756 0323 COMLST, 323 /SET
|
||
695 00757 0306 306 /FOR
|
||
696 00760 0311 311 /IF
|
||
697 00761 0304 304 /DO
|
||
698 00762 0307 307 /GOTO
|
||
699 00763 0303 303 /COMMENT OR CONTINUE
|
||
700 00764 0301 301 /ASK
|
||
701 00765 0324 324 /TYPE
|
||
702 00766 0314 314 /LIBRARY
|
||
703 00767 0305 305 /ERASE
|
||
704 00770 0327 327 /WRITE
|
||
705 00771 0315 315 /MODIFY
|
||
706 00772 0321 321 /QUIT
|
||
707 00773 0322 322 /RETURN
|
||
708 00774 0317 317 /OPTION
|
||
709 00775 0310 310 /HELLO
|
||
710 /CONDITIONAL TRANSFER PROCESS
|
||
711 / IF (EXP) A,B,C
|
||
712 00776 4511 IF, SORTC /LOOK FOR L-PAR
|
||
713 00777 1022 PLPR-1
|
||
714 01000 7410 SKP
|
||
715 01001 4526 ERROR /NO ( AFTER IF
|
||
716 01002 4501 PUSHJ /EVALUATE EXPRESSION
|
||
717 01003 1600 EVAL-1
|
||
718 01004 4506 GETC /PASS )
|
||
719 01005 1045 TAD FLAC1 /TEST FOR -,0,+
|
||
720 01006 7710 SPA CLA
|
||
721 01007 5622 JMP I PGOTO /NEGATIVE, USE 1ST REF
|
||
722 01010 4565 TSTERM /0 OR POS, GET TO NEXT
|
||
723 01011 5210 JMP .-1
|
||
724 01012 5703 JMP I PRCP /; OR CR, CONTINUE SAME LINE
|
||
725 01013 1045 TAD FLAC1 /COMMA, SEE IF 0 OR POS
|
||
726 01014 7650 SNA CLA
|
||
727 01015 5622 JMP I PGOTO /ZERO, USE 2ND REF
|
||
728 01016 4565 TSTERM /POSITIVE, GET TO NEXT
|
||
729 01017 5216 JMP .-1
|
||
730 01020 5703 JMP I PRCP /; OR CR
|
||
731 01021 5622 JMP I PGOTO /COMMA, USE 3RD REF
|
||
732 01022 0610 PGOTO, GOTO
|
||
733 01023 0250 PLPR, 250
|
||
734 /ASSIGNMENT AND LOOP CONTROL
|
||
735 SET=.
|
||
736 01024 4501 FOR, PUSHJ /GET POINTER TO VAR.
|
||
737 01025 1404 GETARG
|
||
738 01026 4521 SPNOR
|
||
739 01027 4511 SORTC /SEARCH FOR =
|
||
740 01030 2024 TERMS+17-1
|
||
741 01031 7410 SKP
|
||
742 01032 4526 ERROR /LEFT OF = IN ERROR: "FOR" OR "SET"
|
||
743 01033 1154 TAD PT1 /SAVE VARIABLE POINTER
|
||
744 01034 3332 DCA PT2
|
||
745 01035 4501 PUSHJ /EVALUATE INITIAL EXPRESSION
|
||
746 01036 1600 EVAL-1
|
||
747 01037 4407 FENT /SAVE INITIAL VALUE
|
||
748 01040 6732 FPT I PT2
|
||
749 01041 0000 FEXT
|
||
750 01042 4565 TSTERM /CHECK TERMINATOR
|
||
751 01043 4526 ERROR /PROBABLY EXCESS R-PAR
|
||
752 01044 5703 JMP I PRCP /; OR CR: THIS IS A SET; CONTINUE
|
||
753 01045 1332 TAD PT2 /COMMA, SAVE LOOP VAR POINTER
|
||
754 01046 4503 PUSHA
|
||
755 01047 4501 PUSHJ /EVALUATE SECOND EXPRESSION
|
||
756 01050 1601 EVAL
|
||
757 01051 4565 TSTERM /CHECK TERMINATOR
|
||
758 01052 4526 ERROR /EXCESS R-PAR OR BAD TERMINATOR
|
||
759 01053 5317 JMP ONEINC /; OR CR, THAT'S ALL (INC=1)
|
||
760 01054 4504 PUSHF /COMMA, SAVE INCREMENT
|
||
761 01055 2034 FLARG
|
||
762 01056 4501 PUSHJ /EVALUATE FINAL EXPRESSION
|
||
763 01057 1601 EVAL
|
||
764 01060 4504 SFINAL, PUSHF /SAVE FINAL VALUE
|
||
765 01061 2034 FLARG
|
||
766 01062 4724 JMS I FTXS /SAVE CHAR AND TEXT POINTERS
|
||
767 01063 4430 FLOAT /FLOAT A ZERO TO START
|
||
768 01064 4407 FCONT, FENT /COMPARE LOOP VAR TO FINAL
|
||
769 01065 1732 FAD I PT2 /LOOP VAR
|
||
770 01066 6732 FPT I PT2
|
||
771 01067 2560 FSB I FLARGP /FINAL
|
||
772 01070 0000 FEXT
|
||
773 01071 1013 TAD PDLXR /CHECK SIGN OF INCREMENT
|
||
774 01072 1322 TAD PINC
|
||
775 01073 3332 DCA PT2
|
||
776 01074 1732 TAD I PT2
|
||
777 01075 7710 SPA CLA
|
||
778 01076 4450 NEGATE /BACKWARD COUNTING
|
||
779 01077 1045 TAD FLAC1
|
||
780 01100 7740 SMA SZA CLA
|
||
781 01101 5326 JMP FEND /LIMIT REACHED OR EXCEEDED
|
||
782
|
||
783 01102 4501 PUSHJ /NOT YET, DO OBJECT STATEMENTS
|
||
784 01103 0616 PRCP, PROC
|
||
785 01104 4725 JMS I FTXR /RESET TO BEGINNING OF OBJ. STMT.
|
||
786 01105 4505 POPF /RESTORE LIMIT
|
||
787 01106 2034 FLARG
|
||
788 01107 4505 POPF /RESTORE INC
|
||
789 01110 0044 FLAC
|
||
790 01111 1413 POPA /RESTORE LOOP VAR POINTER
|
||
791 01112 3332 DCA PT2
|
||
792 01113 1323 TAD M13 /PUSH DOWN ALL OF ABOVE
|
||
793 01114 1013 TAD PDLXR
|
||
794 01115 3013 DCA PDLXR
|
||
795 01116 5264 JMP FCONT
|
||
796 /////
|
||
797 01117 4504 ONEINC, PUSHF /NO INCREMENT GIVEN, SET TO 1
|
||
798 01120 1573 FLTONE
|
||
799 01121 5260 JMP SFINAL
|
||
800 /////
|
||
801 01122 0011 PINC, 11
|
||
802 01123 7765 M13, -13
|
||
803 01124 2435 FTXS, TXTSAV
|
||
804 01125 2443 FTXR, TXTRES
|
||
805 01126 1005 FEND, TAD P13 /END OF LOOP
|
||
806 01127 1013 TAD PDLXR /REMOVE VALUES!FROM PUSHDOWN LIST
|
||
807 01130 3013 DCA PDLXR
|
||
808 01131 5502 POPJ
|
||
809 01132 0000 PT2, 0
|
||
810 /////
|
||
811 /ASK/TYPE SPECIAL CHARACTERS
|
||
812 01133 0246 ALIST, 246 /&
|
||
813 01134 0245 245 /%
|
||
814 01135 0242 242 /"
|
||
815 01136 0241 241 /!
|
||
816 01137 0243 243 /#
|
||
817 01140 0244 244 /$
|
||
818 01141 0240 GLIST, 240 /SPACE
|
||
819 01142 0254 TLIST, 254 /,
|
||
820 01143 0273 273 /;
|
||
821 01144 0215 215 /C.R.
|
||
822 /SET Y AND INTENSIFY THE POINT
|
||
823 01145 4452 XDYS, FIX
|
||
824 01146 6063 6063 /DYL
|
||
825 01147 7200 CLA
|
||
826 01150 1361 TAD X0
|
||
827 01151 6053 6053 /DXL DIX
|
||
828 01152 7410 SKP
|
||
829 /
|
||
830 /SET X
|
||
831 01153 4452 XDXS, FIX
|
||
832 01154 3361 DCA X0 /(DXL)
|
||
833 01155 5500 RETURN
|
||
834 /
|
||
835 /TAKE THE INTEGER PART
|
||
836 01156 4452 XINT, FIX
|
||
837 01157 7200 CLA
|
||
838 01160 5500 RETURN
|
||
839 01161 0000 X0, 0
|
||
840 /////
|
||
841 01162 1252 TLIST3, TASK4 /"
|
||
842 01163 1210 TASK /C.R. - AUTOMATIC QUOTE MATCH
|
||
843 /COMMAND POINTERS
|
||
844 01164 1024 COMGO, SET
|
||
845 01165 1024 FOR
|
||
846 01166 0776 IF
|
||
847 01167 0416 DO
|
||
848 01170 0610 GOTO
|
||
849 01171 0620 COMMENTS
|
||
850 01172 1206 ASK
|
||
851 01173 1207 TYPE
|
||
852 01174 6556 LIBRARY
|
||
853 01175 2226 ERASE
|
||
854 01176 0641 WRITE
|
||
855 01177 1273 MODIFY
|
||
856 01200 0177 START
|
||
857 01201 1554 RETRN
|
||
858 01202 6446 OPTION
|
||
859 01203 3274 HELLO
|
||
860 /////
|
||
861 01204 3040 PACLS2, PQUES
|
||
862 01205 3065 RUB1
|
||
863 /INPUT-OUTPUT STATEMENTS
|
||
864
|
||
865 01206 7240 ASK, CLA CMA /REMEMBER WHICH CALL.
|
||
866 01207 3131 TYPE, DCA ATSW
|
||
867 01210 3151 TASK, DCA DEBGSW /RE-ENABLE THE TRACE
|
||
868 01211 4510 SORTJ /SPECIAL CHARACTER?
|
||
869 01212 1132 ALIST-1
|
||
870 01213 0426 ATLIST-ALIST
|
||
871 01214 2131 ISZ ATSW /TEST QUOTE SWITCH
|
||
872 01215 5227 JMP TYPE2
|
||
873 01216 4501 PUSHJ /DO ASK; SETUP PT1
|
||
874 01217 1404 GETARG
|
||
875 01220 4636 JMS I TTXTS /PROTECT TEXT
|
||
876 01221 1233 TAD COL /TYPE COLON
|
||
877 01222 4512 TASKCL, PRINTC /(CLA) TO SUPPRESS ":"
|
||
878 01223 4626 JMS I INTERP /CALL INPUT CONVERSION ROUTINE
|
||
879 01224 4637 JMS I TTXTR /RESTORE TEXT
|
||
880 01225 5206 JMP ASK /CONTINUE PROCESSING
|
||
881 01226 3306 INTERP, INTASK
|
||
882 ////
|
||
883 01227 4501 TYPE2, PUSHJ /DO TYPE
|
||
884 01230 1601 EVAL
|
||
885 01231 4565 TSTERM
|
||
886 01232 4526 ERROR /BAD TERMINATOR IN "TYPE"
|
||
887 01233 0272 COL, 272
|
||
888 01234 4640 JMS I OUTS /PRINT
|
||
889 01235 5207 JMP TYPE
|
||
890 /////
|
||
891 01236 2435 TTXTS, TXTSAV
|
||
892 01237 2443 TTXTR, TXTRES
|
||
893 01240 3365 OUTS, OUTPT
|
||
894
|
||
895 01241 2151 TQUOT, ISZ DEBGSW /DISABLE TRACE
|
||
896 01242 4506 GETC /TYPE LITERALS
|
||
897 01243 4510 SORTJ
|
||
898 01244 1404 TLIST2-1
|
||
899 01245 7555 TLIST3-TLIST2
|
||
900 01246 4512 PRINTC
|
||
901 01247 5242 JMP TQUOT+1
|
||
902 //////
|
||
903 01250 1060 TCRLF, TAD CCR /SLASH=CR,LF.
|
||
904 01251 4512 PRINTC
|
||
905 01252 4506 TASK4, GETC /MOVE TO NEXT CHARACTER
|
||
906 01253 5210 JMP TASK
|
||
907 ////
|
||
908 01254 1060 TCRLF2, TAD CCR /SPLAT=CR
|
||
909 01255 4537 JMS I OUTDEV
|
||
910 01256 1015 TAD C200 /DELAY FOR C.R.
|
||
911 01257 5251 JMP TCRLF+1
|
||
912
|
||
913 /IF DEBGSW=0 : ENABLE FLIP-FLOP "DMPSW"
|
||
914 / #0: DISABLE AND RETURN ALL"?" ' S.
|
||
915 /IF DMPSW = 0: TRACE ON, IF ENABLED
|
||
916 / #0: TRACE OFF
|
||
917 /IF BOTH = 0 : PRINT TRACE.
|
||
918
|
||
919
|
||
920 01260 4506 TINTR, GETC /PASS PERCENT SIGN
|
||
921 01261 4672 JMS I INTG /READ FORMAT CONTROL: "%7.3"
|
||
922 01262 1164 TAD DECNUM /INTEGER PART (TOTAL DIGITS)
|
||
923 01263 3051 DCA TOTDIG
|
||
924 01264 4522 TESTN /GET PAST . IF ANY
|
||
925 01265 4506 GETC
|
||
926 01266 4672 JMS I INTG /RIGHT-HAND PART (DECIMAL PLACES)
|
||
927 01267 1164 TAD DECNUM
|
||
928 01270 3133 DCA DECP
|
||
929 01271 5210 JMP TASK
|
||
930 01272 6010 INTG, DECINT
|
||
931 /SEARCH ROUTINES
|
||
932
|
||
933 01273 4515 MODIFY, GETLN /READ LINE NO.
|
||
934 01274 4516 FINDLN /LOOK IT UP NOW.
|
||
935 01275 4526 ERROR2 /NOT THERE = BAD COMMAND UNLESS ZERO.
|
||
936 01276 1134 TAD BUFR /SET POINTERS
|
||
937 01277 3010 DCA AXIN /FOR INPUT
|
||
938 01300 3136 DCA XCTIN
|
||
939 01301 1143 TAD LINENO /COPY THE SAME LINE NUMBER.
|
||
940 01302 7450 SNA /CHECK FOR ALL
|
||
941 01303 5275 JMP MODIFY+2 /ERROR IN ARG
|
||
942 01304 3410 DCA I AXIN /(X-MEM)
|
||
943 01305 1010 TAD AXIN /SAVE START OF NEW LINE
|
||
944 01306 3153 DCA PACKST
|
||
945 01307 4540 SCONT, JMS I INDEV /READ THE TELETYPE INPUT SILENTLY.
|
||
946 01310 3061 DCA LIST3+1 /SAVE SEARCH CHARACTER
|
||
947 01311 2151 ISZ DEBGSW /NO BREAKS.
|
||
948 01312 4506 SCHAR, GETC /TYPE+TEST-F.F.
|
||
949 01313 4512 PRINTC
|
||
950 01314 4510 SORTJ /LOOK FOR MATCH
|
||
951 01315 0057 LIST3-1
|
||
952 01316 1322 LISTGO-LIST3
|
||
953 01317 4507 PACKC /SAVE NEW LINE.
|
||
954 01320 5312 JMP SCHAR
|
||
955 /////
|
||
956 01321 1134 SBAR, TAD BUFR /RESTART-B.A.
|
||
957 01322 7001 IAC
|
||
958 01323 3010 DCA AXIN /SET POINTERS
|
||
959 01324 3136 DCA XCTIN
|
||
960 01325 4513 SFOUND, READC /READ FROM KEYBOARD
|
||
961 01326 4510 SORTJ /TEST
|
||
962 01327 0053 LIST6-1
|
||
963 01330 1322 SRNLST-LIST6
|
||
964 01331 4507 SGOT, PACKC /PACK CHAR.
|
||
965 01332 5325 JMP SFOUND /MORE
|
||
966
|
||
967 01333 0000 SORTB, 0 /SORT AND BRANCH ROUTINE. - "SORTJ"
|
||
968 01334 7450 SNA
|
||
969 01335 1142 TAD CHAR /ASSUME CHAR IF AC=0
|
||
970 01336 7041 CIA
|
||
971 01337 3157 DCA T2 /SAVE SORT ITEM
|
||
972 01340 1733 TAD I SORTB /FIRST ARG IS LIST LESS ONE
|
||
973 01341 2333 ISZ SORTB /2AND IS INTRA-LIST LENGTH
|
||
974 01342 3012 DCA XRT2
|
||
975 01343 1412 TAD I XRT2
|
||
976 01344 7510 SPA /**LISTS ENDED BY NEGATIVE NUMBERS**
|
||
977 01345 5357 JMP SEX /READ EXIT
|
||
978 01346 1157 TAD T2 /FIND ADDRESS
|
||
979 01347 7640 SZA CLA
|
||
980 01350 5343 JMP .-5
|
||
981 01351 1012 TAD XRT2 /MATCH FOUND.
|
||
982 01352 1733 TAD I SORTB
|
||
983 01353 3333 DCA SORTB /SETUP RETURN
|
||
984 01354 1733 TAD I SORTB
|
||
985 01355 3333 DCA SORTB
|
||
986 01356 7410 SKP
|
||
987 01357 2333 SEX, ISZ SORTB /MATCH NOT FOUND.
|
||
988 01360 7300 CLA CLL
|
||
989 01361 5733 JMP I SORTB /RETURN TO CALLING SEQUENCE.
|
||
990
|
||
991 01362 4501 TAB, PUSHJ /TABULATE TO A PARTICULAR COLUMN
|
||
992 01363 1600 EVAL-1
|
||
993 01364 4452 FIX /GET COLUMN NUMBER
|
||
994 01365 7141 CLL CIA
|
||
995 01366 7001 IAC
|
||
996 01367 1053 TAD TABCTR
|
||
997 01370 7630 SZL CLA
|
||
998 01371 5210 JMP TASK /ALREADY THERE OR PAST IT
|
||
999 01372 1033 TAD C240
|
||
1000 01373 4512 PRINTC
|
||
1001 01374 1046 TAD FLAC2 /TEST AGAIN
|
||
1002 01375 5365 JMP TAB+3
|
||
1003 SRNLST=. /'MODIFY' CONTROL CHARACTER TABLE
|
||
1004 01376 1321 SBAR /B.A. = RESTART
|
||
1005 01377 1312 SCHAR /F.F. = CONTINUE
|
||
1006 01400 1307 SCONT /BELL = CHANGE SEARCH CHARACTER
|
||
1007 01401 1310 SCONT+1 /L.F. = FINISH THE LINE AS BEFORE.
|
||
1008 /////
|
||
1009 01402 0263 LISTGO, INPUTX-11 /C.R. - END THE MODIFIED LINE HERE
|
||
1010 01403 1331 SGOT /FOUND SEARCH CHARACTER
|
||
1011 /FIND OR ENTER A VARIABLE IN THE LIST.
|
||
1012
|
||
1013 01404 4525 GETARG, TESTC /FIRST LETTER OF ARG
|
||
1014 01405 0242 TLIST2, 0242 /"
|
||
1015 01406 0215 0215 /C.R. - FUNCTION OR NUMBER IS NOT AN ARG.
|
||
1016 01407 4526 ERROR4 /BAD ARGUEMENT IN 'FOR' 'SET', OR 'ASK'
|
||
1017 01410 7240 CLA CMA /"GETARG" CAN CREATE NEW VAR.
|
||
1018 01411 4503 GETVAR, PUSHA /"GETVAR" WILL NOT
|
||
1019 01412 3136 DCA XCTIN /PACK INTO ADD.
|
||
1020 01413 4507 PACKC
|
||
1021 01414 4506 GETC /SECOND LETTER
|
||
1022 01415 4511 SORTC /TERMINATOR?
|
||
1023 01416 2005 TERMS-1
|
||
1024 01417 5222 JMP .+3 /YES
|
||
1025 01420 1142 TAD CHAR /NO
|
||
1026 01421 0071 AND P77 /SAVE 2AND LETTER OF NAME
|
||
1027 01422 1135 TAD ADD
|
||
1028 01423 4503 PUSHA
|
||
1029 01424 4511 SORTC /IGNORE THE REST
|
||
1030 01425 2005 TERMS-1
|
||
1031 01426 5231 JMP .+3
|
||
1032 01427 4506 GETC
|
||
1033 01430 5224 JMP .-4
|
||
1034 01431 4523 TSTLPR /LOOK FOR SUBSCRIPT VIA SORTCN
|
||
1035 01432 5243 JMP GS1 /NOT SUBSCRIPTED BY L-PAR.
|
||
1036 01433 1130 TAD LASTOP /SAVE LAST OPERATION
|
||
1037 01434 4503 PUSHA
|
||
1038 01435 4501 PUSHJ /MOVE PAST L-PAR AND
|
||
1039 01436 1600 EVAL-1 /EVALUATE THE SUBSCRIPT.
|
||
1040 01437 4506 GETC /MOVE PAST R-PAR
|
||
1041 01440 1413 POPA
|
||
1042 01441 3130 DCA LASTOP /RECALL LAST OPERATION
|
||
1043 01442 4452 FIX
|
||
1044 01443 3324 GS1, DCA SUBS /SAVE SUBSCRIPT
|
||
1045 01444 1413 POPA
|
||
1046 01445 3135 DCA ADD /RESTORE NAME
|
||
1047 01446 1134 TAD STARTV /SEARCH FOR VARIABLE
|
||
1048 01447 3154 GS3, DCA PT1
|
||
1049 01450 1154 TAD PT1
|
||
1050 01451 3011 DCA XRT
|
||
1051 01452 1154 TAD PT1
|
||
1052 01453 7041 CIA
|
||
1053 01454 1155 TAD LASTV /TEST FOR END OF LIST
|
||
1054 01455 7750 SPA SNA CLA
|
||
1055 01456 5267 JMP GS2 /END SEARCH
|
||
1056 01457 1554 TAD I PT1 /GET TABLE ENTRY
|
||
1057 01460 7041 CIA
|
||
1058 01461 1135 TAD ADD
|
||
1059 01462 7650 SNA CLA
|
||
1060 01463 5312 JMP GFND1 /FOUND XX
|
||
1061
|
||
1062 01464 1154 GS4, TAD PT1 /TRY NEXT ONE
|
||
1063 01465 1144 TAD GINC
|
||
1064 01466 5247 JMP GS3
|
||
1065 01467 2413 GS2, ISZ I PDLXR /VAR. NOT FOUND, CAN I MAKE ONE?
|
||
1066 01470 4526 ERROR /UNDEFINED VAR. USED IN EXPRESSION
|
||
1067 01471 1155 TAD LASTV /OK, ADD THE VARIABLE
|
||
1068 01472 1005 TAD P13 /TEST STORAGE LIMITS
|
||
1069 01473 7141 CIA CLL
|
||
1070 01474 1013 TAD PDLXR
|
||
1071 01475 7620 SNL CLA
|
||
1072 01476 4526 ERROR3
|
||
1073 01477 1155 TAD LASTV /UPDATE THE LIST.
|
||
1074 01500 1144 TAD GINC
|
||
1075 01501 3155 DCA LASTV
|
||
1076 01502 1135 TAD ADD /SAVE NAME
|
||
1077 01503 3554 DCA I PT1
|
||
1078 01504 1324 TAD SUBS /SAVE SUBSCRIPT
|
||
1079 01505 3411 DCA I XRT
|
||
1080 01506 3411 DCA I XRT /INITIALIZE VAR. TO ZERO
|
||
1081 01507 3411 DCA I XRT
|
||
1082 01510 3411 DCA I XRT
|
||
1083 01511 5320 JMP GS5 /EXIT
|
||
1084 /////
|
||
1085 01512 1411 GFND1, TAD I XRT /FOUND NAME, TEST SUBSCRIPT
|
||
1086 01513 7041 CIA
|
||
1087 01514 1324 TAD SUBS
|
||
1088 01515 7640 SZA CLA
|
||
1089 01516 5264 JMP GS4 /WRONG SUBSCRIPT
|
||
1090 01517 2013 ISZ PDLXR
|
||
1091 01520 2154 GS5, ISZ PT1 /SET POINTER TO DATA
|
||
1092 01521 2154 ISZ PT1
|
||
1093 01522 5502 POPJ
|
||
1094 ////
|
||
1095 01523 1575 P0, FLTZER
|
||
1096
|
||
1097 /IGNORE LEADING SPACES - "SPNOR"
|
||
1098
|
||
1099 SUBS=.
|
||
1100 01524 0000 XSPNOR, 0
|
||
1101 01525 1142 TAD CHAR
|
||
1102 01526 1063 TAD M240
|
||
1103 01527 7640 SZA CLA
|
||
1104 01530 5724 JMP I XSPNOR
|
||
1105 01531 4506 GETC
|
||
1106 01532 5325 JMP XSPNOR+1
|
||
1107 /////
|
||
1108 /SEE IF NEXT CHARACTER IS A NUMBER
|
||
1109 01533 0000 XTESTN, 0 /RETURNS: .; OTHER; NUMBER - "TESTN"
|
||
1110 01534 1142 TAD CHAR
|
||
1111 01535 1064 TAD MPER /TEST FOR .
|
||
1112 01536 7440 SZA
|
||
1113 01537 2333 ISZ XTESTN /NOT A .
|
||
1114 01540 1352 TAD NTST1 /COMPARE TO "9"
|
||
1115 01541 7500 SMA
|
||
1116 01542 5350 JMP NTEXIT /TOO LARGE
|
||
1117 01543 1353 TAD NTST2 /COMPARE TO "0"
|
||
1118 01544 7510 SPA
|
||
1119 01545 5350 JMP NTEXIT /TOO SMALL
|
||
1120 01546 3127 DCA SORTCN /FOUND DIGIT, SAVE IT
|
||
1121 01547 2333 ISZ XTESTN
|
||
1122 01550 7300 NTEXIT, CLA CLL
|
||
1123 01551 5733 JMP I XTESTN
|
||
1124 /////
|
||
1125 01552 7764 NTST1, 256-272
|
||
1126 01553 0012 NTST2, 272-260
|
||
1127 /EXIT FROM A "DO" SUBROUTINE
|
||
1128
|
||
1129
|
||
1130 01554 1323 RETRN, TAD P0 /(PC) => 0
|
||
1131 01555 3145 DCA PC
|
||
1132 01556 1413 XPOPJ, TAD I PDLXR /RECURSIVE EXIT - "POPJ"
|
||
1133 01557 3157 DCA T2
|
||
1134 01560 5557 JMP I T2
|
||
1135
|
||
1136
|
||
1137 /ASK-TYPE CONTROL CHARACTER TABLE
|
||
1138 01561 1362 ATLIST, TAB /& - TABULATION DELIMITER
|
||
1139 01562 1260 TINTR /% - FORMAT DELIMITER
|
||
1140 01563 1241 TQUOT /" - LITERAL DELIMITER
|
||
1141 01564 1250 TCRLF /! - CARRIAGE RETURN AND LINE FEED
|
||
1142 01565 1254 TCRLF2 /# - CARRIAGE RETURN ONLY
|
||
1143 01566 3125 TDUMP /$/- DUMP THE SYMBOL TABLE CONTENTS
|
||
1144 01567 1252 TASK4 /SP- TERMINATOR FOR NAMES
|
||
1145 01570 1252 TASK4 /, - TERMINATOR FOR EXPRESSIONS
|
||
1146 01571 0615 PROCESS /; - TERMINATOR FOR COMMANDS
|
||
1147 01572 0620 PC1 /C.R. - TERMINATOR FOR STRINGS
|
||
1148 /////
|
||
1149 01573 0001 FLTONE, 0001
|
||
1150 01574 2000 2000
|
||
1151 01575 0000 FLTZER, 0000
|
||
1152 01576 0000 0000
|
||
1153 01577 0000 0000
|
||
1154 /EVALUATE AN EXPRESSION WHICH
|
||
1155 /TERMINATES WITH AN R-PAR,; OR C.R. AND
|
||
1156 /LEAVE THE RESULT IN FLAC AND IN FLARG.
|
||
1157
|
||
1158
|
||
1159
|
||
1160
|
||
1161 01600 4506 GETC /MOVE PAST EXTRA CHARACTER
|
||
1162 01601 3130 EVAL, DCA LASTOP /EVAUATION CONTROLLER (CHECKPOINT ?)
|
||
1163 01602 4525 TESTC /TEST CHARACTER AND IGNORE SPACES
|
||
1164 01603 5215 JMP ETERM1 /TERMIOATION
|
||
1165 01604 5332 JMP ENUM /NUMBER
|
||
1166 01605 5342 JMP EFUN /FUNCTION
|
||
1167 01606 4501 PUSHJ /LETTER OF VARIABLE
|
||
1168 01607 1411 GETVAR /FIND OR CREATE VARIABLE;ALSO SET PT1.
|
||
1169 01610 4525 OPNEXT, TESTC /PT1=>ARG
|
||
1170 01611 5236 JMP ETERMN /T
|
||
1171 01612 0212 ECHOLST,0212 /N-ERROR IN FORMAT
|
||
1172 01613 0377 0377 /F
|
||
1173 01614 4526 ERROR4 /L - MISSING OPERATOR
|
||
1174 /////
|
||
1175 01615 4504 ETERM1, PUSHF /INITIALIZE RESULT TO ZERO.
|
||
1176 01616 1575 FLTZER
|
||
1177 01617 4505 POPF
|
||
1178 01620 2034 FLARG
|
||
1179 01621 1160 TAD FLARGP /SET PT1.
|
||
1180 01622 3154 DCA PT1
|
||
1181 01623 1034 TAD M2 /TEST FOR UNARY OPERATIONS
|
||
1182 01624 1127 TAD SORTCN
|
||
1183 01625 7450 SNA
|
||
1184 01626 5241 JMP ETERM /CREATE DUMMY FOR UNARY MINUS
|
||
1185 01627 7001 IAC
|
||
1186 01630 7650 SNA CLA
|
||
1187 01631 5323 JMP ARGNXT /IGNORE UNARY PLUS
|
||
1188 01632 1127 TAD SORTCN /TEST FOR NULL PARENS.
|
||
1189 01633 1070 TAD M11
|
||
1190 01634 7710 SPA CLA
|
||
1191 01635 5353 JMP ELPAR /MIGHT BE AN L-PAR.
|
||
1192 01636 4523 ETERMN, TSTLPR
|
||
1193 01637 7410 SKP
|
||
1194 01640 4526 ERROR4 /OPERATOR MISSING BEFORE PAREN
|
||
1195 01641 1127 ETERM, TAD SORTCN /SET FROM "TESTC"-"SORTC"
|
||
1196 01642 3147 DCA THISOP
|
||
1197 01643 1147 TAD THISOP
|
||
1198 01644 1070 TAD M11
|
||
1199 01645 7700 SMA CLA /END?
|
||
1200 01646 3147 DCA THISOP /"THISOP" EQUIV. TO END OF EXP.
|
||
1201
|
||
1202 01647 7201 ETERM2, CLA IAC /COMPARE PRIORITIES
|
||
1203 01650 0147 AND THISOP /PRIORITIES ARE: (^),(*/),(+-),PUT
|
||
1204 01651 1147 TAD THISOP
|
||
1205 01652 7041 CIA
|
||
1206 01653 3274 DCA FLOPR
|
||
1207 01654 7001 IAC
|
||
1208 01655 0130 AND LASTOP
|
||
1209 01656 1130 TAD LASTOP
|
||
1210 01657 1274 TAD FLOPR
|
||
1211 01660 7710 SPA CLA
|
||
1212 01661 5310 JMP EPAR /CONTINUE
|
||
1213 01662 1130 TAD LASTOP /FIND OPERATION FROM TABLE
|
||
1214 01663 1331 TAD OPTABL
|
||
1215 01664 3274 DCA FLOPR
|
||
1216 01665 1674 TAD I FLOPR
|
||
1217 01666 3274 DCA FLOPR
|
||
1218 01667 1130 TAD LASTOP
|
||
1219 01670 7640 SZA CLA /TEST FOR END OF DATA INTO FLOATING AC.
|
||
1220 01671 4505 POPF /GET LAST DATA
|
||
1221 01672 0044 FLAC
|
||
1222 01673 4407 FENT
|
||
1223 01674 0000 FLOPR, 00 /(FLOPR I PT1) +-*/^
|
||
1224 01675 6560 FPT I FLARGP /SAVE RESULT
|
||
1225 01676 0000 FEXT
|
||
1226 01677 1160 TAD FLARGP
|
||
1227 01700 3154 DCA PT1
|
||
1228 01701 1147 TAD THISOP
|
||
1229 01702 1130 TAD LASTOP /=0?
|
||
1230 01703 7650 SNA CLA
|
||
1231 01704 5502 POPJ /EXIT "EVAL"
|
||
1232 01705 1413 POPA /GET PRIOR OP
|
||
1233 01706 3130 DCA LASTOP
|
||
1234 01707 5247 JMP ETERM2 /COMPARE THIS OP
|
||
1235 /////
|
||
1236 01710 4523 EPAR, TSTLPR /TEST FOR SUB-EXPRESSION
|
||
1237 01711 7410 SKP
|
||
1238 01712 5355 JMP EPAR2 /GO EVALUATE EXPRESSION
|
||
1239 01713 1130 TAD LASTOP /CONTINUE READING THE EXPRESSION
|
||
1240 01714 4503 PUSHA /SAVE "LASTOP".
|
||
1241 01715 1154 TAD PT1
|
||
1242 01716 3320 DCA .+2
|
||
1243 01717 4504 PUSHF /SAVE LAST ARGUMENT
|
||
1244 01720 0000 00
|
||
1245 01721 1147 TAD THISOP /MORE TO COME
|
||
1246 01722 3130 DCA LASTOP
|
||
1247 01723 4506 ARGNXT, GETC /READ 1ST CHAR OF AN ARG.
|
||
1248 01724 4525 TESTC /DO SPECIAL CHECK
|
||
1249 01725 5353 JMP ELPAR /COULD BE LEFT PAREN
|
||
1250 01726 5332 JMP ENUM /N
|
||
1251 01727 5342 JMP EFUN /F
|
||
1252 01730 5206 JMP OPNEXT-2 /L
|
||
1253 01731 2026 OPTABL, OPTABS
|
||
1254 /////
|
||
1255
|
||
1256 01732 4504 ENUM, PUSHF /TO PROCESS A NUMBER,SAVE AC
|
||
1257 01733 0044 FLAC
|
||
1258 01734 1160 TAD FLARGP /SET POINTER AS FOR A VARIABLE.
|
||
1259 01735 3154 DCA PT1
|
||
1260 01736 4473 JMS I FINPUT /READ TEXT NUMBER => (PT1)
|
||
1261 01737 4505 POPF /RESTORE THE AC
|
||
1262 01740 0044 FLAC
|
||
1263 01741 5210 JMP OPNEXT /CONTINUE
|
||
1264 /////
|
||
1265 01742 3274 EFUN, DCA FLOPR /SET CODE
|
||
1266 01743 4506 GETC /READ FUNCTION NAME.(1,2,OR 3 LETTERS)
|
||
1267 01744 4511 SORTC /LOOK FOR TERMINATION CHARACTER.
|
||
1268 01745 2005 TERMS-1
|
||
1269 01746 5364 JMP EFUN2 /YES
|
||
1270 01747 1274 TAD FLOPR /NO
|
||
1271 01750 7104 CLL RAL /MISH-MASH HASH CODE
|
||
1272 01751 1142 TAD CHAR
|
||
1273 01752 5342 JMP EFUN
|
||
1274 01753 4523 ELPAR, TSTLPR
|
||
1275 01754 4526 ERROR4 /DOUBLE OPERATORS
|
||
1276 01755 1127 EPAR2, TAD SORTCN /LEFT PARENS FOUND.
|
||
1277 01756 4503 PUSHA
|
||
1278 01757 1130 TAD LASTOP /SAVE DATA
|
||
1279 01760 4503 PUSHA
|
||
1280 01761 4501 PUSHJ /EVALUATE THE EXPRESSION
|
||
1281 01762 1600 EVAL-1
|
||
1282 01763 5500 JMP I EFUN3I
|
||
1283 ///
|
||
1284 01764 1127 EFUN2, TAD SORTCN /SAVE 'SORTCN','LASTOP',AND FUNC CODE
|
||
1285 01765 4503 PUSHA
|
||
1286 01766 1130 TAD LASTOP
|
||
1287 01767 4503 PUSHA
|
||
1288 01770 1274 TAD FLOPR /SAVE FUNCTION CODE.
|
||
1289 01771 4503 PUSHA
|
||
1290 01772 4523 TSTLPR
|
||
1291 01773 4526 ERROR4 /MUST BE FOLLOWED BY PARENS TO SET ARGUMENT
|
||
1292 01774 4501 PUSHJ /YES
|
||
1293 01775 1600 EVAL-1
|
||
1294 01776 1413 POPA /BRANCH ON FUNCTION CODE;RETURN VIA EFUN3I.
|
||
1295 01777 4510 SORTJ
|
||
1296 02000 2207 FNTABL-1
|
||
1297 02001 6361 FNTABF-FNTABL
|
||
1298 02002 4526 ERROR2 /ILLEGAL FUNCTION NAME.
|
||
1299 /////
|
||
1300
|
||
1301 02003 0241 241 /!
|
||
1302 02004 0242 242 /"
|
||
1303 02005 0256 256 /. -FOR INPUT NUMBERS
|
||
1304 TERMS=. /TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR'
|
||
1305 02006 0240 240 /SPACE 0
|
||
1306 02007 0253 253 /+ 1
|
||
1307 02010 0255 255 /- 2
|
||
1308 02011 0257 257 // 3
|
||
1309 02012 0252 252 /* 4
|
||
1310 02013 0336 336 /UP ARR 5
|
||
1311 02014 0250 250 /( 6 L-PARS
|
||
1312 02015 0333 333 /[ 7
|
||
1313 02016 0274 274 /< 10
|
||
1314 02017 0251 251 /) 11 R-PARS
|
||
1315 02020 0335 335 /] 12
|
||
1316 02021 0276 276 /> 13
|
||
1317 02022 0254 254 /, 14
|
||
1318 02023 0273 273 /; 15
|
||
1319 02024 0215 215 /C.R. 16
|
||
1320 02025 0275 275 /= TO END GETARG FROM 'SET'
|
||
1321 02026 5554 OPTABS, FGT I PT1
|
||
1322 02027 1554 FAD I PT1
|
||
1323 02030 2554 FSB I PT1
|
||
1324 02031 4554 FDV I PT1
|
||
1325 02032 3554 FMY I PT1
|
||
1326 02033 0554 FPW I PT1
|
||
1327 /////
|
||
1328 02034 0000 FLARG, 0 /DATA TEMPORARY STORAGE
|
||
1329 02035 0000 0
|
||
1330 02036 0000 0
|
||
1331 /////
|
||
1332 /FOCAL TEXT FOR "HELLO" COMMAND
|
||
1333 02037 7056 HPT, 7056 /[T %] 8.4;
|
||
1334 02040 6473 6473
|
||
1335 02041 1740 1740 /OPTION K,T,I,E,:,S;
|
||
1336 02042 1354 1354
|
||
1337 02043 2454 2454
|
||
1338 02044 1154 1154
|
||
1339 02045 0554 0554
|
||
1340 02046 7254 7254
|
||
1341 02047 2373 2373
|
||
1342 02050 0540 0540 /ERASE ALL
|
||
1343 02051 0177 0177
|
||
1344 02052 1500 1500
|
||
1345 /////
|
||
1346 /ABSOLUTE VALUE FUNCTION
|
||
1347 02053 1045 XABS, TAD FLAC1
|
||
1348 02054 7710 SPA CLA
|
||
1349 02055 4450 NEGATE
|
||
1350 /CONTINUATION OF FUNCTION CALLS.
|
||
1351
|
||
1352 02056 1413 EFUN3, POPA /RESTORE LAST OPERATION
|
||
1353 02057 3130 DCA LASTOP
|
||
1354 02060 4407 FENT
|
||
1355 02061 7000 FNR /NORMALIZE FUNCTION RETURN
|
||
1356 02062 6034 FPT FLARG
|
||
1357 02063 0000 FEXT
|
||
1358 02064 1160 TAD FLARGP /SET POINTER
|
||
1359 02065 3154 DCA PT1
|
||
1360 02066 1413 POPA /GET LAST PAREN CODE.
|
||
1361 02067 7041 CIA /CHECK FOR PAREN MATCH.
|
||
1362 02070 1066 TAD M3
|
||
1363 02071 1127 TAD SORTCN /(STILL SET FROM THE LAST "EVAL")
|
||
1364 02072 7640 SZA CLA /SKIP IF MATCH
|
||
1365 02073 4526 ERROR4 /PAREN ERROR
|
||
1366 02074 4506 GETC /MOVE PAST R-PAR, AND RETURN TO OPNEX.
|
||
1367 02075 5676 JMP I .+1 /FUNCTION RETURN IS OK
|
||
1368 02076 1610 OPNEXT
|
||
1369 ////
|
||
1370
|
||
1371 02077 0000 LPRTST, 0 /SKIP IF LEFT PAREN. - 'TSTLPR'
|
||
1372 02100 1127 TAD SORTCN
|
||
1373 02101 1070 TAD M11
|
||
1374 02102 7700 SMA CLA
|
||
1375 02103 5677 JMP I LPRTST
|
||
1376 02104 1127 TAD SORTCN
|
||
1377 02105 1067 TAD M5
|
||
1378 02106 7740 SMA SZA CLA
|
||
1379 02107 2277 ISZ LPRTST
|
||
1380 02110 5677 JMP I LPRTST
|
||
1381
|
||
1382 /THE DELETE A LINE ROUTINE
|
||
1383
|
||
1384 02111 4516 DELETE, FINDLN /SETS "THISLN" AND "LASTLN".
|
||
1385 02112 5502 POPJ /ALREADY GONE
|
||
1386 02113 2151 ISZ DEBGSW /DISABLE TRACE
|
||
1387 02114 4506 GETC /MEASURE LENGTH
|
||
1388 02115 1142 TAD CHAR
|
||
1389 02116 1065 TAD MCR
|
||
1390 02117 7640 SZA CLA
|
||
1391 02120 5314 JMP .-4
|
||
1392 02121 1017 TAD AXOUT /SAVE LAST ADDRESS
|
||
1393 02122 7040 CMA
|
||
1394 02123 1146 TAD THISLN
|
||
1395 02124 3132 DCA CNTR /LENGTH < 0
|
||
1396 02125 1546 TAD I THISLN /DISCONNECT
|
||
1397 02126 3550 DCA I LASTLN
|
||
1398 02127 1075 TAD CFRS /START LIST AT TOP
|
||
1399 02130 3157 DOK, DCA T2 /EXAMINATION ADDRESS
|
||
1400 02131 1557 TAD I T2 /GET THE NEXT ADDR.
|
||
1401 02132 7450 SNA /TEST FOR END
|
||
1402 02133 5346 JMP DONE /YES-WRAP UP ALL.
|
||
1403 02134 3156 DCA T1 /SAVE NEXT ADDRESS.
|
||
1404 02135 1146 TAD THISLN /COMPARE LINE POSITIONS
|
||
1405 02136 7141 CIA CLL
|
||
1406 02137 1156 TAD T1
|
||
1407 02140 7630 SZL CLA /SKIP IF THISLN > X
|
||
1408 02141 1132 TAD CNTR /CHANGE (X) TO ACCOUNT FOR
|
||
1409 02142 1156 TAD T1 /GARBAGE COLLECTION.
|
||
1410 02143 3557 DCA I T2
|
||
1411 02144 1156 TAD T1 /GET NEXT
|
||
1412 02145 5330 JMP DOK
|
||
1413 /////
|
||
1414 /GARBAGE COLLECTION
|
||
1415
|
||
1416 02146 7040 DONE, CMA /BACKUP L FOR XR
|
||
1417 02147 1146 TAD THISLN
|
||
1418 02150 3011 DCA XRT
|
||
1419 02151 1132 TAD CNTR /SETUP END OF HOSE
|
||
1420 02152 7040 CMA
|
||
1421 02153 1146 TAD THISLN
|
||
1422 02154 3012 DCA XRT2
|
||
1423 02155 1132 TAD CNTR /CORRECT END OF BUFFER POINTER.
|
||
1424 02156 1134 TAD BUFR
|
||
1425 02157 3134 DCA BUFR
|
||
1426 02160 1010 TAD AXIN /COMPUTE COUNT
|
||
1427 02161 7040 CMA
|
||
1428 02162 1012 TAD XRT2
|
||
1429 02163 3156 DCA T1
|
||
1430 02164 1010 TAD AXIN
|
||
1431 02165 1132 TAD CNTR
|
||
1432 02166 3010 DCA AXIN
|
||
1433 02167 1412 TAD I XRT2 /SIPHON LOWER PART.
|
||
1434 02170 3411 DCA I XRT
|
||
1435 02171 2156 ISZ T1
|
||
1436 02172 5367 JMP .-3
|
||
1437 02173 5311 JMP DELETE /RESET 'LASTLN','THISLN', AND DATA`FIELD.
|
||
1438 /////
|
||
1439 /OPTION TABLE
|
||
1440 02174 6457 OPTTBL, OPTK /SWITCH TO KEYBOARD INPUT
|
||
1441 02175 6453 OPTR /READER INPUT
|
||
1442 02176 3237 OPTT /TTY OUTPUT
|
||
1443 02177 3234 OPTP /PUNCH OUTPUT
|
||
1444 02200 3303 OPTI /INTERPRETIVE/NUMERIC I/O
|
||
1445 02201 3302 OPTC /SINGLE CHARACTER I/O
|
||
1446 02202 3244 OPTCOL /PRINT ":" AT "ASK"
|
||
1447 02203 3243 OPTX /SUPPRESS ":"
|
||
1448 02204 3252 OPTE /ECHO KEYBOARD INPUT
|
||
1449 02205 3253 OPTN /NO ECHO
|
||
1450 02206 3256 OPTS /SET VARIABLE TERMINATOR
|
||
1451 02207 3271 OPTM /START DISK MONITOR
|
||
1452
|
||
1453 FNTABL=.
|
||
1454 02210 2533 2533 /ABS
|
||
1455 02211 2650 2650 /SGN
|
||
1456 02212 2636 2636 /ITR
|
||
1457 02213 2565 2565 /DIS
|
||
1458 02214 2630 2630 /RAN
|
||
1459 02215 2623 2623 /DXS
|
||
1460 02216 2517 2517 /ADC
|
||
1461 02217 2572 2572 /ATN
|
||
1462 02220 2624 2624 /EXP
|
||
1463 02221 2625 2625 /LOG
|
||
1464 02222 2654 2654 /SIN /LIST OF CODED FUNCTION NAMES
|
||
1465 02223 2575 2575 /COS
|
||
1466 02224 2702 2702 /SQT
|
||
1467 02225 2631 2631 /NEW
|
||
1468 /ERASE SINGLE LINES, GROUPS, OR VARIABLES
|
||
1469 02226 1142 ERASE, TAD CHAR /SEE IF "ALL"
|
||
1470 02227 1003 TAD MINUSA
|
||
1471 02230 7640 SZA CLA
|
||
1472 02231 5240 JMP ERVX
|
||
1473 02232 1077 TAD ENDT /YES, ERASE ALL TEXT
|
||
1474 02233 3134 DCA BUFR
|
||
1475 02234 3475 DCA I CFRS
|
||
1476 02235 1134 ERV, TAD STARTV /ERASE VARIABLES
|
||
1477 02236 3155 DCA LASTV
|
||
1478 02237 5177 JMP START /PROGRAM EXECUTION ENDS
|
||
1479 /////
|
||
1480 02240 4515 ERVX, GETLN /GET LINE NUMBER
|
||
1481 02241 1143 TAD LINENO /SEE OF ZERO OR NONE
|
||
1482 02242 7640 SZA CLA
|
||
1483 02243 5250 JMP ERL /NO, ERASE LINES
|
||
1484 02244 1134 TAD STARTV /YES, ERASE VARIABLES
|
||
1485 02245 3155 DCA LASTV
|
||
1486 02246 5647 JMP I .+1 /CONTINUE PROCESSING
|
||
1487 02247 0616 PROC
|
||
1488 /////
|
||
1489 02250 1134 ERL, TAD BUFR /ERASE LINES
|
||
1490 02251 3010 DCA AXIN
|
||
1491 02252 4501 ERG, PUSHJ /EXTRACT ONE LINE
|
||
1492 02253 2111 DELETE
|
||
1493 02254 2146 ISZ THISLN
|
||
1494 02255 1141 TAD NAGSW
|
||
1495 02256 7700 SMA CLA
|
||
1496 02257 1546 TAD I THISLN
|
||
1497 02260 4524 TSTGRP /IF GROUP, SEE IF END OF GROUP
|
||
1498 02261 5235 JMP ERV /YES
|
||
1499 02262 1546 TAD I THISLN /NO, CONTINUE ERASING GROUP
|
||
1500 02263 3143 DCA LINENO
|
||
1501 02264 5252 JMP ERG
|
||
1502 /ROUTINE CALLED VIA "FINDLN":
|
||
1503
|
||
1504 /SEARCH FOR A GIVEN LINE I.D. =[ "LINENO" ]
|
||
1505 /1ST RETURN IF NOT FOUND,
|
||
1506 /2AND IF FOUND.
|
||
1507 /"THISLN" = FOUND LINE OR NEXT LARGER.
|
||
1508 /"LASTLN" = LESSER AND/OR LAST.
|
||
1509 /"TEXTP" IS SET
|
||
1510
|
||
1511 02265 0000 XFIND, 0
|
||
1512 02266 1075 TAD CFRS /INITIALIZE POINTERS TO FIRST LINE
|
||
1513 02267 3150 DCA LASTLN
|
||
1514 02270 1075 TAD CFRS
|
||
1515 02271 3146 FINDN, DCA THISLN /SAVE THIS ONE
|
||
1516 02272 1146 TAD THISLN
|
||
1517 02273 3012 DCA XRT2
|
||
1518 02274 1143 TAD LINENO
|
||
1519 02275 7041 CIA
|
||
1520 02276 1412 TAD I XRT2 /LINENO=0 WILL ALSO BE FOUND
|
||
1521 02277 7450 SNA
|
||
1522 02300 2265 ISZ XFIND /FOUND IT (2ND EXIT)
|
||
1523 02301 7700 SMA CLA
|
||
1524 02302 5310 JMP FEND3 /PAST IT.
|
||
1525 02303 1146 TAD THISLN /MOVE POINTERS
|
||
1526 02304 3150 DCA LASTLN
|
||
1527 02305 1546 TAD I THISLN
|
||
1528 02306 7440 SZA /SKIP IF END OF TEST
|
||
1529 02307 5271 JMP FINDN
|
||
1530 02310 1146 FEND3, TAD THISLN
|
||
1531 02311 7001 IAC
|
||
1532 02312 3017 DCA AXOUT /SET "TEXTP".
|
||
1533 02313 3020 DCA XCT
|
||
1534 02314 5665 JMP I XFIND
|
||
1535
|
||
1536 02315 0000 UTRA, 0 /UNPACK CHARACTER. - "GETC"
|
||
1537 02316 4351 JMS GET1
|
||
1538 02317 7710 UTE, SPA CLA /NORM & EXTEND
|
||
1539 02320 1006 TAD C100 /300-337 & 340-376
|
||
1540 02321 1377 TAD M137 /240-276 & 200-236
|
||
1541 02322 1142 TAD CHAR
|
||
1542 02323 7450 SNA
|
||
1543 02324 5337 JMP UTX /"?" FOUND
|
||
1544 02325 1054 TAD P337
|
||
1545 02326 3142 UTQ, DCA CHAR
|
||
1546 02327 1151 TAD DEBGSW
|
||
1547 02330 1152 TAD DMPSW
|
||
1548 02331 7650 SNA CLA /PRINT ONLY IF BOTH ARE ZERO.
|
||
1549 02332 4512 PRINTC
|
||
1550 02333 5715 JMP I UTRA
|
||
1551 //////
|
||
1552 02334 4351 EXTR, JMS GET1
|
||
1553 02335 7040 CMA
|
||
1554 02336 5317 JMP UTE
|
||
1555 ///
|
||
1556 02337 1151 UTX, TAD DEBGSW /TEST FOR TRACE-ENABLED
|
||
1557 02340 7640 SZA CLA
|
||
1558 02341 5347 JMP .+6
|
||
1559 02342 1152 TAD DMPSW /FLIP THE TRACE FLOP
|
||
1560 02343 7650 SNA CLA
|
||
1561 02344 7001 IAC
|
||
1562 02345 3152 DCA DMPSW
|
||
1563 02346 5316 JMP UTRA+1 /GET NEXT CHARACTER INSTEAD.
|
||
1564 02347 1032 TAD P277 /TRACE DISABLED = RETURN "?"
|
||
1565 02350 5326 JMP UTQ
|
||
1566
|
||
1567 02351 0000 GET1, 0 /UNPACK 6-BITS
|
||
1568 02352 2020 ISZ XCT /STARTS=0
|
||
1569 02353 5366 JMP GET3
|
||
1570 02354 1021 TAD GTEM
|
||
1571 02355 0071 GEND, AND P77
|
||
1572 02356 3142 DCA CHAR /SAVE
|
||
1573 02357 1142 TAD CHAR
|
||
1574 02360 1023 TAD M77
|
||
1575 02361 7650 SNA CLA
|
||
1576 02362 5334 JMP EXTR /EXTENDED
|
||
1577 02363 1142 TAD CHAR
|
||
1578 02364 1376 TAD M40
|
||
1579 02365 5751 JMP I GET1
|
||
1580 /////
|
||
1581
|
||
1582 02366 1417 GET3, TAD I AXOUT /(X-MEM)
|
||
1583 02367 3021 DCA GTEM
|
||
1584 02370 7040 CMA
|
||
1585 02371 3020 DCA XCT
|
||
1586 02372 1021 TAD GTEM
|
||
1587 02373 4520 RTL6
|
||
1588 02374 7004 RAL
|
||
1589 02375 5355 JMP GEND
|
||
1590 02376 7740 M40, -40
|
||
1591 02377 7641 M137, -137
|
||
1592 /////
|
||
1593 /OPTION LIST
|
||
1594 02400 0313 OPTLST, "K
|
||
1595 02401 0322 "R
|
||
1596 02402 0324 "T
|
||
1597 02403 0320 "P
|
||
1598 02404 0311 "I
|
||
1599 02405 0303 "C
|
||
1600 02406 0272 ":
|
||
1601 02407 0330 "X
|
||
1602 02410 0305 "E
|
||
1603 02411 0316 "N
|
||
1604 02412 0323 "S
|
||
1605 02413 0315 "M
|
||
1606 /////
|
||
1607 /ANALOG-DIGITAL CONVERSION
|
||
1608 02414 6004 XADC, 6004
|
||
1609 02415 3045 DCA FLAC1 /ARG MUST BE 0
|
||
1610 02416 5500 RETURN
|
||
1611
|
||
1612 02417 0000 XENDLN, 0 /TERMINATE THE BUFFERED LINE - "ENDLN"
|
||
1613 02420 1550 TAD I LASTLN /SAVE OLD POINTER
|
||
1614 02421 3534 DCA I BUFR
|
||
1615 02422 1134 TAD BUFR /POINT TO NEW LAST LINE
|
||
1616 02423 3550 DCA I LASTLN
|
||
1617 02424 1135 TAD ADD /CHECK FOR EXTRA INFO
|
||
1618 02425 7440 SZA
|
||
1619 02426 3410 DCA I AXIN
|
||
1620 02427 1010 TAD AXIN /COMPUTE NEW`END OF BUFFER
|
||
1621 02430 7001 IAC
|
||
1622 02431 3134 DCA BUFR
|
||
1623 02432 1134 TAD STARTV /RESET VARIABLE LIST
|
||
1624 02433 3155 DCA LASTV
|
||
1625 02434 5617 JMP I XENDLN
|
||
1626 /////
|
||
1627 02435 0000 TXTSAV, 0 /SAVE CHAR AND TEXT POINTERS
|
||
1628 02436 4504 PUSHF
|
||
1629 02437 0017 TEXTP
|
||
1630 02440 1142 TAD CHAR
|
||
1631 02441 4503 PUSHA
|
||
1632 02442 5635 JMP I TXTSAV
|
||
1633 /
|
||
1634 02443 0000 TXTRES, 0 /RESTORE SAME
|
||
1635 02444 1413 POPA
|
||
1636 02445 3142 DCA CHAR
|
||
1637 02446 4505 POPF
|
||
1638 02447 0017 TEXTP
|
||
1639 02450 5643 JMP I TXTRES
|
||
1640 /////
|
||
1641 02451 0000 GRPTST, 0 /AC VS LINENO - "TSTGRP"
|
||
1642 02452 0024 AND P7600
|
||
1643 02453 7041 CIA
|
||
1644 02454 3157 DCA T2
|
||
1645 02455 1143 TAD LINENO
|
||
1646 02456 0024 AND P7600
|
||
1647 02457 1157 TAD T2
|
||
1648 02460 7650 SNA CLA
|
||
1649 02461 2251 ISZ GRPTST
|
||
1650 02462 5651 JMP I GRPTST
|
||
1651 /I-O SUBROUTINES
|
||
1652
|
||
1653 VAL=.
|
||
1654 02463 0000 CHIN, 0 /READ IN A CHARACTER SUBR. - "READC"
|
||
1655 02464 4540 JMS I INDEV
|
||
1656 02465 3142 DCA CHAR
|
||
1657 02466 4511 SORTC /LINEFEED OR RUBOUT?
|
||
1658 02467 1611 ECHOLST-1
|
||
1659 02470 5663 JMP I CHIN /YES
|
||
1660 02471 4512 ECHO, PRINTC
|
||
1661 02472 1142 TAD CHAR /SEE IF 200 (L/T)
|
||
1662 02473 1024 TAD P7600
|
||
1663 02474 7640 SZA CLA
|
||
1664 02475 5663 JMP I CHIN /NO, EXIT
|
||
1665 02476 5264 JMP CHIN+1 /YES, GET ANOTHER
|
||
1666 /////
|
||
1667 02477 0000 OUT, 0 /OUTPUT A CHARACTER - "PRINTC"
|
||
1668 02500 7450 SNA /USE (AC) OR (CHAR)
|
||
1669 02501 1142 TAD CHAR
|
||
1670 02502 1065 TAD MCR
|
||
1671 02503 7450 SNA
|
||
1672 02504 5310 JMP OUTCR
|
||
1673 02505 1060 TAD CCR
|
||
1674 02506 4537 JMS I OUTDEV
|
||
1675 02507 5677 OUTX, JMP I OUT
|
||
1676 /////
|
||
1677 02510 1060 OUTCR, TAD CCR
|
||
1678 02511 4537 JMS I OUTDEV
|
||
1679 02512 1057 TAD CLF
|
||
1680 02513 5306 JMP OUTX-1
|
||
1681 /////
|
||
1682 /TEST FOR A COMMA, SEMICOLON, OR CR - "TSTERM"
|
||
1683 /RETURNS: OTHER, ; OR CR, COMMA
|
||
1684 /GETS NEXT CHARACTER AFTER COMMA OR OTHER
|
||
1685 02514 0000 XTSTER, 0
|
||
1686 02515 4511 SORTC /LOOK FOR ,;CR
|
||
1687 02516 1141 TLIST-1
|
||
1688 02517 7410 SKP
|
||
1689 02520 5326 JMP .+6 /OTHER, GO PAST IT
|
||
1690 02521 1127 TAD SORTCN /FOUND ONE, SEE WHAT IT IS
|
||
1691 02522 2314 ISZ XTSTER
|
||
1692 02523 7640 SZA CLA
|
||
1693 02524 5714 JMP I XTSTER /; OR CR: 2ND EXIT
|
||
1694 02525 2314 ISZ XTSTER /COMMA, 3RD EXIT
|
||
1695 02526 4506 GETC
|
||
1696 02527 5714 JMP I XTSTER
|
||
1697 /////
|
||
1698
|
||
1699 COMEIN=.-1 /COMMAND-INPUT BUFFER LIVES HERE.
|
||
1700
|
||
1701 COMOUT=2600
|
||
1702 *COMOUT
|
||
1703
|
||
1704 /INTERRUPT PROCESSOR.
|
||
1705
|
||
1706 02600 0000 SAVAC, 0 /CONTENTS OF AC
|
||
1707 02601 0000 SAVLK, 0 /CONTENTS OF LINK
|
||
1708 02602 7575 MBREAK, -203 /CONTROL-C
|
||
1709 02603 3200 INTRPT, DCA SAVAC /SAVE WORKING DATA
|
||
1710 02604 7010 RAR
|
||
1711 02605 3201 DCA SAVLK
|
||
1712 02606 6031 KSF /CHECK FOR KEYBOARD FIRST
|
||
1713 02607 5225 JMP TINT
|
||
1714 02610 6036 KRB /READ BUFFER AND CLEAR FLAG TO FETCH NEXT
|
||
1715 02611 0026 AND P177 /IGNORE PARITY BIT
|
||
1716 02612 1015 TAD C200
|
||
1717 02613 3306 DCA SIN
|
||
1718 02614 1306 TAD SIN
|
||
1719 02615 1202 TAD MBREAK /MANUAL STOP?
|
||
1720 02616 7650 SNA CLA
|
||
1721 02617 5345 JMP RECOVR
|
||
1722 02620 1264 TAD INBUF /ANY SPACE?
|
||
1723 02621 7640 SZA CLA
|
||
1724 02622 4526 ERROR2 /WILL WAIT FOR OUTPUT BUFFER
|
||
1725 02623 1306 TAD SIN
|
||
1726 02624 3264 DCA INBUF /SAVE INPUT
|
||
1727 02625 6041 TINT, TSF
|
||
1728 02626 5244 JMP EXIT
|
||
1729 02627 6042 TCF
|
||
1730 02630 3260 DCA TELSW /TURN OFF THE IN-PROGRESS FLAG.
|
||
1731 02631 1663 TAD I OPTRI
|
||
1732 02632 7450 SNA
|
||
1733 02633 5244 JMP EXIT /DONE
|
||
1734 02634 6044 TPC /TYPE NEXT.
|
||
1735 02635 3260 DCA TELSW /CLEAR AC AND TURN ON THE FLAG.
|
||
1736 02636 3663 DCA I OPTRI /ZERO OUT THE DATA AREA
|
||
1737 02637 1263 TAD OPTRI
|
||
1738 02640 7001 IAC
|
||
1739 02641 0031 AND P17
|
||
1740 02642 1261 TAD OPTR0
|
||
1741 02643 3263 DCA OPTRI
|
||
1742 02644 6244 EXIT, 6244 /RESTORE MEMORY FIELD
|
||
1743 02645 6101 6101 /SMP
|
||
1744 02646 7000 NOP /(HLT)-IF YOU HAVE MEMORY PARITY
|
||
1745 02647 6011 RSF /TEST H.S. READER FLAG
|
||
1746 02650 5253 JMP .+3
|
||
1747 02651 6012 RRB /READ BUFFER AND CLEAR FLAG
|
||
1748 02652 3037 DCA HINBUF /SAVE CHARACTER
|
||
1749 02653 1201 TAD SAVLK
|
||
1750 02654 7104 RAL CLL
|
||
1751 02655 1200 TAD SAVAC
|
||
1752 02656 6001 ION
|
||
1753 02657 5400 EXITJ, JMP I 0
|
||
1754
|
||
1755 02660 0001 TELSW, 1 /INPUT SWITCH
|
||
1756 02661 3400 OPTR0, IOBUF /OUTPUT POINTERS
|
||
1757 02662 3400 OPTRO, IOBUF /VARS
|
||
1758 02663 3400 OPTRI, IOBUF
|
||
1759 02664 0000 INBUF, 0 /KEYBOARD BUFFER.
|
||
1760 /////
|
||
1761 02665 0000 XI33, 0 /VIA (INDEV)
|
||
1762 02666 1264 TAD INBUF /ANY INPUT?
|
||
1763 02667 7550 SPA SNA
|
||
1764 02670 5266 JMP .-2 /NO = WAIT
|
||
1765 02671 3275 DCA XOUTL
|
||
1766 02672 3264 DCA INBUF /CLEAR INPUT BUFFER
|
||
1767 02673 1275 TAD XOUTL
|
||
1768 02674 5665 JMP I XI33
|
||
1769 /////
|
||
1770 02675 0000 XOUTL, 0 /VIA (OUTDEV)
|
||
1771 02676 3265 DCA XI33 /SAVE CURRENT CHARACTER.
|
||
1772 02677 1265 TAD XI33 /IS IT A CR?
|
||
1773 02700 1065 TAD MCR
|
||
1774 02701 7650 SNA CLA
|
||
1775 02702 3053 DCA TABCTR /YES, RESET CARRIAGE INDEX
|
||
1776 02703 1265 TAD XI33
|
||
1777 02704 4732 JMS I SKPNP /SKIP IF A NON-PRINTING CHARACTER
|
||
1778 02705 2053 ISZ TABCTR /PRINTING: INCREMENT INDEX
|
||
1779 02706 0000 SIN, 0
|
||
1780 02707 6001 ION /BE SURE INTERRUPT IS ON.
|
||
1781 02710 1662 TAD I OPTRO /ANY ROOM?
|
||
1782 02711 7640 SZA CLA /A CHARACTER IS NON-ZERO
|
||
1783 02712 5310 JMP .-2 /NO = WAIT.
|
||
1784 02713 1260 TAD TELSW /IN PROGRESS?
|
||
1785 02714 7640 SZA CLA
|
||
1786 02715 5322 JMP .+5
|
||
1787 02716 1265 TAD XI33 /NO
|
||
1788 02717 6046 TLS /TYPE CHARACTER.
|
||
1789 02720 3260 DCA TELSW /SET IN-PROGRESS FLAG.
|
||
1790 02721 5675 JMP I XOUTL /RETURN
|
||
1791 02722 1265 TAD XI33 /SEND DATA
|
||
1792 02723 3662 DCA I OPTRO
|
||
1793 02724 1262 TAD OPTRO /SET POINTERS
|
||
1794 02725 7001 IAC
|
||
1795 02726 0031 AND P17
|
||
1796 02727 1261 TAD OPTR0
|
||
1797 02730 3262 DCA OPTRO
|
||
1798 02731 5675 JMP I XOUTL
|
||
1799 ///////
|
||
1800 02732 3014 SKPNP, SKIPNP
|
||
1801 ERROR2=ERROR; ERROR3=ERROR; ERROR4=ERROR
|
||
1802 02733 3225 WAITP, OWAIT
|
||
1803 02734 3203 OPTDOP, OPTTDO
|
||
1804 02735 3336 ERROR5, DCA .+1 /ERROR CALLED FROM A TABLE
|
||
1805 02736 0000 ERR2, 0 /LIMIT EXCEEDED
|
||
1806 02737 7240 CLA CMA /COMPUTE CALLING ADDRESS (ALSO "SPACE")
|
||
1807 02740 1336 TAD ERR2 /AND USE IT AS ERROR NUMBER.
|
||
1808 02741 3143 DCA LINENO /SAVE ERROR CODE.
|
||
1809 02742 4733 JMS I WAITP /WAIT FOR OUTPUT TO FINISH
|
||
1810 02743 6002 IOF /DISABLE INTERRUPT FOR INITIALIZATIONS
|
||
1811 02744 5347 JMP .+3
|
||
1812 02745 1015 RECOVR, TAD C200
|
||
1813 02746 3143 DCA LINENO /SAVE ERROR NUMBER
|
||
1814 02747 2260 ISZ TELSW /TURN ON IN-PROGRESS SWITCH
|
||
1815 02750 1025 TAD M20 /SETUP INIT COUNT
|
||
1816 02751 3132 DCA CNTR
|
||
1817 02752 7040 CMA
|
||
1818 02753 1261 TAD OPTR0
|
||
1819 02754 3011 DCA XRT /INIT I/O BUFFERS.
|
||
1820 02755 3411 DCA I XRT
|
||
1821 02756 2132 ISZ CNTR
|
||
1822 02757 5355 JMP .-2
|
||
1823 02760 3264 DCA INBUF /INIT KEY-BUFR.
|
||
1824 02761 1261 TAD OPTR0 /INIT TTY POINTERS.
|
||
1825 02762 3263 DCA OPTRI
|
||
1826 02763 1261 TAD OPTR0
|
||
1827 02764 3262 DCA OPTRO
|
||
1828 02765 4734 JMS I OPTDOP /SET TO TTY OUTPUT
|
||
1829 02766 1161 TAD PTCH /RESET "READC"
|
||
1830 02767 3113 DCA 113 /IF AN ERROR OCCURS.
|
||
1831 02770 7040 CMA /PREPARE A STOP BIT FOR TTY
|
||
1832 02771 6046 TLS /AND RAISE FLAG
|
||
1833 02772 7200 CLA
|
||
1834 02773 1060 TAD CCR /PRINT A CR
|
||
1835 02774 4512 PRINTC
|
||
1836 02775 1032 TAD P277 /MAKE A ?
|
||
1837 02776 4512 PRINTC /AND TURN ON THE INTERRUPT
|
||
1838 02777 4514 PRNTLN /PRINT ERROR NUMBER AND,
|
||
1839 03000 2145 ISZ PC
|
||
1840 03001 1545 TAD I PC /UNLESS IT IS ZERO, (X-MEM)
|
||
1841 03002 7450 SNA
|
||
1842 03003 5211 JMP .+6
|
||
1843 03004 3143 DCA LINENO
|
||
1844 03005 1062 TAD P7700
|
||
1845 03006 4512 PRINTC
|
||
1846 03007 4512 PRINTC /PRINT SPACE AGAIN AND
|
||
1847 03010 4514 PRNTLN /PRINT LINE OF ERROR.
|
||
1848 03011 1060 TAD CCR
|
||
1849 03012 4512 PRINTC
|
||
1850 03013 5177 JMP START /INTERRUPT WILL BE RE-ENABLED SOON.
|
||
1851 /////
|
||
1852 /SKIP IF (AC) IS A NON-PRINTING CHARACTER
|
||
1853 03014 0000 SKIPNP, 0
|
||
1854 03015 4520 RTL6 /PRINTING CHARACTERS ARE 240-337
|
||
1855 03016 7710 SPA CLA
|
||
1856 03017 7020 CML
|
||
1857 03020 7420 SNL
|
||
1858 03021 2214 ISZ SKIPNP
|
||
1859 03022 5614 JMP I SKIPNP
|
||
1860 /////
|
||
1861 /PACK A CHARACTER INTO THE BUFFER - "PACKC"
|
||
1862 03023 0000 PACBUF, 0
|
||
1863 03024 4510 SORTJ /LOOK FOR ? OR RUBOUT
|
||
1864 03025 3055 PACLST-1
|
||
1865 03026 6126 PACLS2-PACLST
|
||
1866 03027 1142 TAD CHAR
|
||
1867 03030 4214 JMS SKIPNP /PRINTING CHARACTER?
|
||
1868 03031 5234 JMP .+3 /YES
|
||
1869 03032 1071 TAD P77 /NO, PACK 77 FIRST
|
||
1870 03033 4242 JMS PCK1
|
||
1871 03034 1142 TAD CHAR /PACK 6-BIT CHARACTER
|
||
1872 03035 0071 AND P77
|
||
1873 03036 4242 JMS PCK1
|
||
1874 03037 5623 JMP I PACBUF
|
||
1875 /////
|
||
1876 03040 1054 PQUES, TAD P337 /USE 337 FOR ?
|
||
1877 03041 5235 JMP .-4
|
||
1878 /////
|
||
1879 /PACK ONE 6-BIT WORD
|
||
1880 03042 0000 PCK1, 0
|
||
1881 03043 2136 ISZ XCTIN
|
||
1882 03044 5260 JMP ROT /PACK LEFT HALF
|
||
1883 03045 1135 TAD ADD /PACK RIGHT HALF AND STORE
|
||
1884 03046 3410 DCA I AXIN
|
||
1885 03047 1013 TAD PDLXR /CHECK FOR SPACE
|
||
1886 03050 7141 CLL CIA
|
||
1887 03051 1005 TAD P13
|
||
1888 03052 1010 TAD AXIN
|
||
1889 03053 7630 SZL CLA
|
||
1890 03054 4526 ERROR /BUFFER OR STORAGE OVERFLOW
|
||
1891 03055 5642 JMP I PCK1
|
||
1892 /////
|
||
1893 03056 0277 PACLST, 277 /?
|
||
1894 03057 0377 377 /RUBOUT
|
||
1895 /////
|
||
1896 03060 4520 ROT, RTL6 /SAVE LEFT HALF
|
||
1897 03061 3135 DCA ADD
|
||
1898 03062 7040 CMA
|
||
1899 03063 3136 DCA XCTIN
|
||
1900 03064 5642 JMP I PCK1
|
||
1901 /RUBOUT ONE CHARACTER
|
||
1902 03065 1010 RUB1, TAD AXIN /SAVE POINTER
|
||
1903 03066 3242 DCA PCK1
|
||
1904 03067 1136 TAD XCTIN /CHARACTER IN ADD?
|
||
1905 03070 7640 SZA CLA
|
||
1906 03071 5277 JMP RUB2 /YES
|
||
1907 03072 1010 TAD AXIN /NO, BEGINNING OF BUFFER?
|
||
1908 03073 7041 CIA
|
||
1909 03074 1153 TAD PACKST
|
||
1910 03075 7700 SMA CLA
|
||
1911 03076 5322 JMP PKZERO /YES, IGNORE
|
||
1912 03077 1324 RUB2, TAD SPLAT /ECHO A BACKSLASH
|
||
1913 03100 4512 PRINTC
|
||
1914 03101 2136 ISZ XCTIN
|
||
1915 03102 5310 JMP RUB3 /BACKUP STORAGE
|
||
1916 03103 1642 TAD I PCK1 /KILL ADD AND CHECK FOR 77
|
||
1917 03104 0071 AND P77 /IN 2ND HALF OF LAST STORED WORD
|
||
1918 03105 1023 TAD M77
|
||
1919 03106 7640 SZA CLA
|
||
1920 03107 5322 JMP PKZERO /NO, DONE
|
||
1921 03110 1642 RUB3, TAD I PCK1 /KILL 2ND HALF OF LAST STORED WORD
|
||
1922 03111 0062 AND P7700
|
||
1923 03112 3135 DCA ADD
|
||
1924 03113 7040 CMA /BACKUP POINTER
|
||
1925 03114 1010 TAD AXIN
|
||
1926 03115 3010 DCA AXIN
|
||
1927 03116 1135 TAD ADD /TEST FOR 77 IN ADD
|
||
1928 03117 1006 TAD C100
|
||
1929 03120 7640 SZA CLA
|
||
1930 03121 7040 CMA
|
||
1931 03122 3136 PKZERO, DCA XCTIN
|
||
1932 03123 5623 JMP I PACBUF
|
||
1933 03124 0334 SPLAT, 334
|
||
1934 /DUMP THE SYMBOL TABLE CONTENTS
|
||
1935 03125 4504 TDUMP, PUSHF /SAVE TEXT POINTERS
|
||
1936 03126 0017 TEXTP
|
||
1937 03127 7040 CMA
|
||
1938 03130 1134 TAD STARTV /START VARIABLE LIST
|
||
1939 03131 3014 TDLOOP, DCA FLTXR
|
||
1940 03132 1014 TAD FLTXR /TEST FOR END OF LIST
|
||
1941 03133 7040 CMA
|
||
1942 03134 1155 TAD LASTV
|
||
1943 03135 7650 SNA CLA
|
||
1944 03136 5370 JMP TDEND /END FOUND
|
||
1945 03137 1375 TAD TDTEXT /NO, SET UP POINTERS
|
||
1946 03140 3017 DCA AXOUT
|
||
1947 03141 3020 DCA XCT
|
||
1948 03142 1414 TAD I FLTXR /2 LETTERS OF VAR. NAME
|
||
1949 03143 3376 DCA TDTEXT+1
|
||
1950 03144 4501 PUSHJ /PRINT NAME AND "("
|
||
1951 03145 1241 TQUOT
|
||
1952 03146 1414 TAD I FLTXR /GET AND PRINT SUBSCRIPT
|
||
1953 03147 4774 JMS I TDOUTP
|
||
1954 03150 4501 PUSHJ /PRINT ")="
|
||
1955 03151 1241 TQUOT
|
||
1956 03152 1005 TAD P13 /SPACE TO 11TH COLUMN
|
||
1957 03153 3046 DCA FLAC2
|
||
1958 03154 4501 PUSHJ
|
||
1959 03155 1374 TAB+12
|
||
1960 03156 2014 ISZ FLTXR
|
||
1961 03157 4407 FENT /PICK UP VALUE
|
||
1962 03160 5414 FGT I FLTXR /(DOES NOT AUTOINDEX)
|
||
1963 03161 0000 FEXT
|
||
1964 03162 4472 JMS I FOUTPUT /PRINT VALUE
|
||
1965 03163 1060 TAD CCR /AND A C.R.
|
||
1966 03164 4512 PRINTC
|
||
1967 03165 1014 TAD FLTXR /INCREMENT FOR NEXT VAR.
|
||
1968 03166 1035 TAD P2
|
||
1969 03167 5331 JMP TDLOOP
|
||
1970 03170 4505 TDEND, POPF /RESTORE TEXT POINTERS
|
||
1971 03171 0017 TEXTP
|
||
1972 03172 5773 JMP I .+1
|
||
1973 03173 1252 TASK4
|
||
1974 03174 6100 TDOUTP, SIGOUT
|
||
1975 03175 3175 TDTEXT, . /THE FOLLOWING IS FOCAL TEXT
|
||
1976 03176 0000 0 /VAR. NAME GOES HERE
|
||
1977 03177 5077 5077 /"(" AND C.R.
|
||
1978 03200 1551 1551 /")=" AND C.R.
|
||
1979 03201 7577 7577
|
||
1980 03202 1500 1500
|
||
1981 /OPTION ROUTINES
|
||
1982 /
|
||
1983 /ROUTINE TO SET UP OUTPUT
|
||
1984 03203 0000 OPTTDO, 0
|
||
1985 03204 1220 TAD CTSF
|
||
1986 03205 3621 DCA I OPTTL /TSF
|
||
1987 03206 1621 TAD I OPTTL
|
||
1988 03207 7001 IAC
|
||
1989 03210 3622 DCA I OPTTL+1 /TCF
|
||
1990 03211 1622 TAD I OPTTL+1
|
||
1991 03212 1035 TAD P2
|
||
1992 03213 3623 DCA I OPTTL+2 /TPC
|
||
1993 03214 1623 TAD I OPTTL+2
|
||
1994 03215 1035 TAD P2
|
||
1995 03216 3624 DCA I OPTTL+3 /TLS
|
||
1996 03217 5603 JMP I OPTTDO
|
||
1997 03220 6041 CTSF, TSF
|
||
1998 03221 2625 OPTTL, TINT
|
||
1999 03222 2627 TINT+2
|
||
2000 03223 2634 TINT+7
|
||
2001 03224 2717 SIN+11
|
||
2002 /////
|
||
2003 /ROUTINE TO WAIT UNTIL OUTPUT FINISHES
|
||
2004 03225 0000 OWAIT, 0
|
||
2005 03226 6001 ION /(SWAP) - FOR 2-USER
|
||
2006 03227 1633 TAD I TSWP /LOOK AT TELSW
|
||
2007 03230 7640 SZA CLA
|
||
2008 03231 5226 JMP .-3
|
||
2009 03232 5625 JMP I OWAIT
|
||
2010 03233 2660 TSWP, TELSW
|
||
2011 /////
|
||
2012 03234 4225 OPTP, JMS OWAIT /SET UP FOR PUNCH OUTPUT
|
||
2013 03235 1025 TAD M20 /CONVERT TO PSF, ETC.
|
||
2014 03236 7410 SKP
|
||
2015 03237 4225 OPTT, JMS OWAIT /SET UP FOR TTY OUTPUT
|
||
2016 03240 4203 JMS OPTTDO
|
||
2017 03241 5642 OPTXIT, JMP I .+1 /EXIT OPTIONS
|
||
2018 03242 6461 OPTRET
|
||
2019
|
||
2020 03243 1250 OPTX, TAD OPTC1 /SUPPRESS ":" ON ASK
|
||
2021 03244 1247 OPTCOL, TAD CPRINT /RESTORE ":"
|
||
2022 03245 3651 DCA I COLP
|
||
2023 03246 5241 JMP OPTXIT
|
||
2024 03247 4512 CPRINT, PRINTC
|
||
2025 03250 2466 OPTC1, CLA-PRINTC
|
||
2026 03251 1222 COLP, TASKCL
|
||
2027 /////
|
||
2028 03252 1247 OPTE, TAD CPRINT /SET UP FOR KEYBOARD ECHO
|
||
2029 03253 3655 OPTN, DCA I ECHP /SUPPRESS ECHO
|
||
2030 03254 5241 JMP OPTXIT
|
||
2031 03255 2471 ECHP, ECHO
|
||
2032 /////
|
||
2033 03256 4506 OPTS, GETC /SET UP USER TERMINATOR FOR "ASK"
|
||
2034 03257 4511 SORTC
|
||
2035 03260 2003 TERMS-3
|
||
2036 03261 7410 SKP
|
||
2037 03262 5256 JMP .-4
|
||
2038 03263 4501 PUSHJ /GET CHARACTER
|
||
2039 03264 1601 EVAL
|
||
2040 03265 4452 FIX
|
||
2041 03266 3670 DCA I USERTP
|
||
2042 03267 5241 JMP OPTXIT
|
||
2043 03270 6002 USERTP, USERT
|
||
2044 /////
|
||
2045 03271 4225 OPTM, JMS OWAIT /EXIT TO DISK MONITOR
|
||
2046 03272 6002 IOF
|
||
2047 03273 5424 JMP I P7600
|
||
2048 /////
|
||
2049 /THIS IS THE INITIALIZATION COMMAND
|
||
2050 03274 1301 HELLO, TAD HP
|
||
2051 03275 3017 DCA AXOUT
|
||
2052 03276 3020 DCA XCT
|
||
2053 03277 4501 PUSHJ /START BY SETTING FORMAT
|
||
2054 03300 1260 TINTR
|
||
2055 /////
|
||
2056 03301 2036 HP, HPT-1 /FOCAL TEXT "%8.4;O K,T,I,E,:,S;E A"
|
||
2057 / I/O MODE OPTIONS
|
||
2058 03302 7240 OPTC, CLA CMA
|
||
2059 03303 3305 OPTI, DCA IOSW
|
||
2060 03304 5241 JMP OPTXIT
|
||
2061 /////
|
||
2062 03305 0000 IOSW, 0
|
||
2063 / I/O MODE: "I" = 0000 = INTERPRETIVE INPUT, NUMERIC OUTPUT
|
||
2064 / "C" = 7777 = SINGLE CHARACTER I/O
|
||
2065 /////
|
||
2066 /"ASK" MASTER ROUTINE
|
||
2067 03306 0000 INTASK, 0
|
||
2068 03307 1154 TAD PT1 /SAVE VAR. POINTER
|
||
2069 03310 3225 DCA OWAIT
|
||
2070 03311 1305 TAD IOSW /WHAT MODE OF INPUT?
|
||
2071 03312 7650 SNA CLA
|
||
2072 03313 5323 JMP STRING /INTERPRETIVE
|
||
2073 03314 4513 READC /SINGLE CHARACTER
|
||
2074 03315 1142 TAD CHAR /CONVERT CHARACTER CODE TO FLOATING
|
||
2075 03316 4430 FLOAT /POINT NUMBER
|
||
2076 03317 4407 ASKEND, FENT /SAVE VALUE
|
||
2077 03320 6625 FPT I OWAIT
|
||
2078 03321 0000 FEXT
|
||
2079 03322 5706 JMP I INTASK
|
||
2080 /INTERPRETIVE BUFFERED INPUT
|
||
2081 03323 1013 STRING, TAD PDLXR /SAVE PUSHDOWN LIST POINTER
|
||
2082 03324 3203 DCA OPTTDO
|
||
2083 03325 1364 TAD BUFTOP /PROTECT TOP OF ASKBUF
|
||
2084 03326 3013 DCA PDLXR
|
||
2085 03327 2151 ISZ DEBGSW /DISABLE TRACE
|
||
2086 03330 1363 INBARR, TAD BUFBOT /INITIALIZE ASKBUF
|
||
2087 03331 3010 DCA AXIN
|
||
2088 03332 3136 DCA XCTIN
|
||
2089 03333 1363 TAD BUFBOT
|
||
2090 03334 3153 DCA PACKST
|
||
2091 03335 4513 READC /IGNORE SPACES
|
||
2092 03336 4511 SORTC
|
||
2093 03337 0032 C240-1
|
||
2094 03340 5335 JMP .-3
|
||
2095 03341 4510 SORTJ /SEARCH FOR TERMINATOR
|
||
2096 03342 5775 ASKLST-1
|
||
2097 03343 0774 ASKLS2-ASKLST
|
||
2098 03344 4507 PACKC /PACK INTO BUFFER
|
||
2099 03345 4513 INGT, READC
|
||
2100 03346 5341 JMP .-5
|
||
2101 /TERMINATOR FOUND, PROCESS INPUT
|
||
2102 03347 1060 INTERM, TAD CCR /PACK A C.R.
|
||
2103 03350 3142 DCA CHAR
|
||
2104 03351 4507 PACKC
|
||
2105 03352 4507 PACKC
|
||
2106 03353 1203 TAD OPTTDO /RESTORE PDLXR
|
||
2107 03354 3013 DCA PDLXR
|
||
2108 03355 1363 TAD BUFBOT /INITIALIZE UNPACKING
|
||
2109 03356 3017 DCA AXOUT
|
||
2110 03357 3020 DCA XCT
|
||
2111 03360 4501 PUSHJ /EVALUATE EXPRESSION
|
||
2112 03361 1600 EVAL-1
|
||
2113 03362 5317 JMP ASKEND
|
||
2114 /////
|
||
2115 03363 7550 BUFBOT, ASKBUF /BOTTOM OF BUFFER
|
||
2116 03364 7612 BUFTOP, ASKBND /TOP+12 OF BUFFER
|
||
2117 /////
|
||
2118 /"TYPE" OUTPUT
|
||
2119 03365 0000 OUTPT, 0
|
||
2120 03366 1305 TAD IOSW /WHAT KIND OF OUTPUT
|
||
2121 03367 7640 SZA CLA
|
||
2122 03370 5373 JMP COUTPT /SINGLE CHARACTER
|
||
2123 03371 4472 JMS I FOUTPUT /NUMERIC OUTPUT, PRINT VALUE
|
||
2124 03372 5765 JMP I OUTPT
|
||
2125 /////
|
||
2126 03373 4452 COUTPT, FIX /GET CODE FOR CHARACTER
|
||
2127 03374 7450 SNA /MODULO 256
|
||
2128 03375 7130 CLL CML RAR /TO ALLOW ZERO CODE TO BE PRINTED
|
||
2129 03376 4537 JMS I OUTDEV
|
||
2130 03377 5765 JMP I OUTPT
|
||
2131 /NOTE: "TDUMP" PRINTS ONLY IN NUMERIC MODE
|
||
2132 IOBUF=3400
|
||
2133 /
|
||
2134 *IOBUF+20
|
||
2135 03420 0000 FRST, 0 /TEXT POINTER
|
||
2136 03421 0000 0000 /DUMMY LINE NO
|
||
2137 03422 0355 0355 / C-
|
||
2138 03423 0617 0617 / FO
|
||
2139 03424 0301 0301 / CA
|
||
2140 03425 1454 1454 / L,
|
||
2141 03426 4040 4040
|
||
2142 03427 6557 6557 / 5/
|
||
2143 03430 6671 FRSTX, 6671 / 69
|
||
2144 03431 7715 7715
|
||
2145 BUFBEG=.
|
||
2146 /////
|
||
2147 /FOCAL INITIALIZATION ROUTINE
|
||
2148 *BUFBEG
|
||
2149 03432 7300 BEGIN, CLA CLL
|
||
2150 03433 1377 TAD (RECOVR+1 /RESTORE RESTART
|
||
2151 03434 3176 DCA START-1
|
||
2152 03435 6002 IOF /CLEAR FLAGS TO PREVENT INTERRUPT
|
||
2153 03436 6022 6022 /PCF
|
||
2154 03437 6032 6032 /KCC
|
||
2155 03440 6203 6203 /CDF CIF 00
|
||
2156 03441 6402 6402 /CLEAR PT08'S
|
||
2157 03442 6412 6412
|
||
2158 03443 6422 6422
|
||
2159 03444 6432 6432
|
||
2160 03445 6442 6442
|
||
2161 03446 6452 6452
|
||
2162 03447 6462 6462
|
||
2163 03450 6472 6472
|
||
2164 03451 6764 6764 /CLEAR DECTAPE
|
||
2165 03452 6772 6772
|
||
2166 03453 7200 CLA
|
||
2167 03454 6046 TLS /START LOW SPEED OUTPUT
|
||
2168 03455 3414 DCA I FLTXR /CLEAR OUTPUT BUFFER
|
||
2169 03456 2376 ISZ (-20
|
||
2170 03457 5255 JMP .-2
|
||
2171 03460 1027 TAD BOTTOM /INITIALIZE PUSHDOWN LIST
|
||
2172 03461 3013 DCA PDLXR
|
||
2173 03462 6001 ION
|
||
2174 03463 4512 PRINTC /CHAR IS A C.R
|
||
2175 03464 4512 PRINTC
|
||
2176 03465 4512 PRINTC
|
||
2177 03466 4501 PUSHJ /TYPE FOCAL HEADING
|
||
2178 03467 0641 WRITE
|
||
2179 03470 5671 JMP I .+1
|
||
2180 03471 2232 ERV-3 /ERASE ALL
|
||
2181
|
||
2182 /EXTENDED FUNCTION PACKAGE FOR FOCAL 5/69
|
||
2183 /E.A.TAFT, 6/10/69
|
||
2184 /
|
||
2185 /FSIN: SIN(X) X IN RADIANS
|
||
2186 /FCOS: COS(X) X IN RADIANS
|
||
2187 /FATN: ARC TAN(X) RESULT IN RADIANS
|
||
2188 /FEXP: EXP(X)
|
||
2189 /FLOG: LN(X)
|
||
2190 /////
|
||
2191 /DEFINITIONS
|
||
2192 FIXMRI FAD=1000
|
||
2193 FIXMRI FSB=2000
|
||
2194 FIXMRI FMY=3000
|
||
2195 FIXMRI FDV=4000
|
||
2196 FIXMRI FGT=5000
|
||
2197 FIXMRI FPT=6000
|
||
2198 FNR=7000
|
||
2199 FENT=4407
|
||
2200 FEXT=0
|
||
2201 /////
|
||
2202 NEGATE= 4450
|
||
2203 GETSGN= 1045
|
||
2204 RETURN= 5500
|
||
2205 SN= 10
|
||
2206 FIX= 4452
|
||
2207 PUSHA= 4503
|
||
2208 POPA= 1413
|
||
2209 FLAC= 44
|
||
2210 FLTEMP= 7545
|
||
2211 FLTONE= 1573
|
||
2212 PDLXR= 13
|
||
2213 ERROR= 4526
|
||
2214 FLOAT= 4430
|
||
2215 FNTABF= 571
|
||
2216 BOTTOM= 27
|
||
2217 COMGO= 1164
|
||
2218 SORTJ= 4510
|
||
2219 M5= 67
|
||
2220 CNTR= 132
|
||
2221 AXIN= 10
|
||
2222 TSTERM= 4565
|
||
2223 PROC= 616
|
||
2224 ERROR5= 2735
|
||
2225 DBCONV= 5600
|
||
2226 03576 7760 *BOTTOM
|
||
03577 2746
|
||
2227 00027 5112 FCOS-1 /TOP OF TEXT
|
||
2228 *FNTABF+7
|
||
2229 00600 5335 FATN /POINTERS TO EXTENDED FUNCTIONS
|
||
2230 00601 5202 FEXP
|
||
2231 00602 5454 FLOG
|
||
2232 00603 5117 FSIN
|
||
2233 00604 5113 FCOS
|
||
2234 /////
|
||
2235 /ENABLE A "LIBRARY DELETE" COMMAND
|
||
2236 /WHICH WILL DELETE THE EXTENDED FUNCTIONS AND
|
||
2237 /FREE MORE FOR USER AREA.
|
||
2238 *COMGO+10
|
||
2239 01174 6556 LIBRARY
|
||
2240 *6555
|
||
2241 06555 0304 LIBLST, "D
|
||
2242 /////
|
||
2243 06556 4510 LIBRARY,SORTJ /"LIBRARY" - EXPANDABLE COMMAND
|
||
2244 06557 6554 LIBLST-1
|
||
2245 06560 0022 LIBGO-LIBLST
|
||
2246 06561 4526 ERROR /ILLEGAL LIBRARY COMMAND
|
||
2247 /////
|
||
2248 06562 1067 LIBD, TAD M5 /DELETE THE EXTENDED FUNCTIONS
|
||
2249 06563 3132 DCA CNTR
|
||
2250 06564 1375 TAD EXTAB
|
||
2251 06565 3010 DCA AXIN
|
||
2252 06566 1175 TAD PERROR
|
||
2253 06567 3410 DCA I AXIN /SET ERROR5 POINTERS
|
||
2254 06570 2132 ISZ CNTR
|
||
2255 06571 5366 JMP .-3
|
||
2256 06572 1376 TAD DTOP
|
||
2257 06573 3027 DCA BOTTOM /MOVE TOP POINTER UP
|
||
2258 06574 5261 JMP 6461 /OPTRET (TO REACH END OF COMMAND)
|
||
2259 /////
|
||
2260 06575 0577 EXTAB, FNTABF+6
|
||
2261 06576 5577 DTOP, DBCONV-1
|
||
2262 06577 6562 LIBGO, LIBD
|
||
2263 *175
|
||
2264 00175 2735 PERROR, ERROR5
|
||
2265 /FOCAL EXTENDED FUNCTIONS
|
||
2266 *5113
|
||
2267 / COSINE
|
||
2268 05113 4450 FCOS, NEGATE /COS(X)=SIN(PI/2-X)
|
||
2269 05114 4407 FENT
|
||
2270 05115 1772 FAD I PI2
|
||
2271 05116 0000 FEXT
|
||
2272 /////
|
||
2273 / SINE
|
||
2274 05117 1045 FSIN, GETSGN
|
||
2275 05120 7450 SNA
|
||
2276 05121 5500 RETURN /SIN(0)=0
|
||
2277 05122 7710 SPA CLA
|
||
2278 05123 4771 JMS I NEG2 /SIN(-X)=-SIN(X)
|
||
2279 05124 3010 DCA SN
|
||
2280 05125 4407 FENT
|
||
2281 05126 5174 FDV TWOPI /REDUCE MODULO 2 PI
|
||
2282 05127 6773 FPT I X2
|
||
2283 05130 0000 FEXT
|
||
2284 05131 4452 FIX
|
||
2285 05132 4450 NEGATE
|
||
2286 05133 4407 FENT
|
||
2287 05134 7000 FNR
|
||
2288 05135 1773 FAD I X2
|
||
2289 05136 7174 FMY TWOPI
|
||
2290 05137 6773 FPT I X2
|
||
2291 05140 7177 FSB PI
|
||
2292 05141 0000 FEXT
|
||
2293 05142 1045 GETSGN /X<PI?
|
||
2294 05143 7710 SPA CLA
|
||
2295 05144 5353 JMP PCHECK /YES
|
||
2296 05145 4407 FENT /NO, SIN(X-PI)=-SIN(X)
|
||
2297 05146 6773 FPT I X2
|
||
2298 05147 0000 FEXT
|
||
2299 05150 1010 TAD SN
|
||
2300 05151 7040 CMA
|
||
2301 05152 3010 DCA SN
|
||
2302 05153 4407 PCHECK, FENT /X<PI/2?
|
||
2303 05154 5773 FGT I X2
|
||
2304 05155 2772 FSB I PI2
|
||
2305 05156 0000 FEXT
|
||
2306 05157 1045 GETSGN
|
||
2307 05160 7710 SPA CLA
|
||
2308 05161 5367 JMP PALGO /YES
|
||
2309 05162 4407 FENT /NO, SIN(X)=SIN(PI-X)
|
||
2310 05163 5177 FGT PI
|
||
2311 05164 2773 FSB I X2
|
||
2312 05165 6773 FPT I X2
|
||
2313 05166 0000 FEXT
|
||
2314 05167 5770 PALGO, JMP I .+1 /PERFORM POWER SERIES EXPANSION
|
||
2315 05170 5540 PALG
|
||
2316
|
||
2317 05171 5321 NEG2, FNEG
|
||
2318 05172 5413 PI2, PIOT
|
||
2319 05173 5325 X2, X
|
||
2320 05174 0003 TWOPI, 0003
|
||
2321 05175 3110 3110
|
||
2322 05176 3761 3761
|
||
2323 05177 0002 PI, 0002
|
||
2324 05200 3110 3110
|
||
2325 05201 3761 3761
|
||
2326 / EXPONENTIAL
|
||
2327 05202 1045 FEXP, GETSGN /TAKE ABSOLUTE VALUE
|
||
2328 05203 7710 SPA CLA
|
||
2329 05204 4321 JMS FNEG
|
||
2330 05205 3010 DCA SN
|
||
2331 05206 4407 FENT
|
||
2332 05207 7272 FMY LG2E
|
||
2333 05210 7325 FPT X
|
||
2334 05211 0000 FEXT
|
||
2335 05212 4452 FIX
|
||
2336 05213 4503 PUSHA /SAVE INTEGER PART
|
||
2337 05214 4450 NEGATE
|
||
2338 05215 4407 FENT
|
||
2339 05216 7000 FNR
|
||
2340 05217 5325 FAD X /RETAIN FRACTIONAL PART
|
||
2341 05220 7325 FPT X
|
||
2342 05221 7325 FMY X
|
||
2343 05222 7330 FPT XSQR
|
||
2344 05223 5267 FAD DF
|
||
2345 05224 6733 FPT I TP
|
||
2346 05225 5264 FGT CF
|
||
2347 05226 4733 FDV I TP
|
||
2348 05227 7325 FSB X
|
||
2349 05230 5256 FAD AF
|
||
2350 05231 6733 FPT I TP
|
||
2351 05232 5261 FGT BF
|
||
2352 05233 7330 FMY XSQR
|
||
2353 05234 1733 FAD I TP
|
||
2354 05235 6733 FPT I TP
|
||
2355 05236 5325 FGT X
|
||
2356 05237 4733 FDV I TP
|
||
2357 05240 7275 FMY TWO
|
||
2358 05241 1734 FAD I ONEPT
|
||
2359 05242 0000 FEXT
|
||
2360 05243 1413 POPA
|
||
2361 05244 1044 TAD FLAC
|
||
2362 05245 3044 DCA FLAC
|
||
2363 05246 2010 ISZ SN /EXP(-X)=1/EXP(X)
|
||
2364 05247 5500 RETURN
|
||
2365 05250 4407 FENT
|
||
2366 05251 7325 FPT X
|
||
2367 05252 5734 FGT I ONEPT
|
||
2368 05253 5325 FDV X
|
||
2369 05254 0000 FEXT
|
||
2370 05255 5500 RETURN
|
||
2371 /EXP AND ARCTANGENT CONSTANTS
|
||
2372 05256 0004 AF, 0004
|
||
2373 05257 2372 2372
|
||
2374 05260 1402 1402
|
||
2375 05261 7774 BF, 7774
|
||
2376 05262 2157 2157
|
||
2377 05263 5157 5157
|
||
2378 05264 0012 CF, 0012
|
||
2379 05265 5454 5454
|
||
2380 05266 0343 0343
|
||
2381 05267 0007 DF, 0007
|
||
2382 05270 2566 2566
|
||
2383 05271 5341 5341
|
||
2384 05272 0001 LG2E, 0001
|
||
2385 05273 2705 2705
|
||
2386 05274 2435 2435
|
||
2387 05275 0002 TWO, 0002
|
||
2388 05276 2000 2000
|
||
2389 05277 0000 BET1, 0000
|
||
2390 05300 2427 2427
|
||
2391 05301 2323 2323
|
||
2392 05302 7775 BET2, 7775
|
||
2393 05303 3427 3427
|
||
2394 05304 7052 7052
|
||
2395 05305 0000 BETZ, 0000
|
||
2396 05306 2437 2437
|
||
2397 05307 1646 1646
|
||
2398 05310 7773 ALF2, 7773
|
||
2399 05311 3306 3306
|
||
2400 05312 5454 5454
|
||
2401 05313 7777 ALF1, 7777
|
||
2402 05314 3304 3304
|
||
2403 05315 4434 4434
|
||
2404 05316 0000 ALFZ, 0000
|
||
2405 05317 2437 2437
|
||
2406 05320 1643 1643
|
||
2407 /////
|
||
2408 /ROUTINE TO NEGATE FLAC AND RETURN WITH AC=7777
|
||
2409 05321 0000 FNEG, 0
|
||
2410 05322 4450 NEGATE
|
||
2411 05323 7040 CMA
|
||
2412 05324 5721 JMP I FNEG
|
||
2413 /VARIABLES
|
||
2414 05325 0000 X, 0
|
||
2415 05326 0000 0
|
||
2416 05327 0000 0
|
||
2417 05330 0000 XSQR, 0
|
||
2418 05331 0000 0
|
||
2419 05332 0000 0
|
||
2420 /POINTERS
|
||
2421 05333 7545 TP, FLTEMP
|
||
2422 05334 1573 ONEPT, FLTONE
|
||
2423 / ARC TANGENT
|
||
2424 05335 1045 FATN, GETSGN /TAKE ABSOLUTE VALUE
|
||
2425 05336 7710 SPA CLA
|
||
2426 05337 4321 JMS FNEG
|
||
2427 05340 3010 DCA SN
|
||
2428 05341 4407 FENT
|
||
2429 05342 7325 FPT X
|
||
2430 05343 5325 FGT X
|
||
2431 05344 2734 FSB I ONEPT
|
||
2432 05345 0000 FEXT
|
||
2433 05346 1045 GETSGN
|
||
2434 05347 7710 SPA CLA
|
||
2435 05350 5357 JMP GO
|
||
2436 05351 4407 FENT
|
||
2437 05352 5734 FGT I ONEPT
|
||
2438 05353 5325 FDV X
|
||
2439 05354 7325 FPT X
|
||
2440 05355 0000 FEXT
|
||
2441 05356 7040 CMA
|
||
2442 05357 4503 GO, PUSHA /SIGN FLAG
|
||
2443 05360 4407 FENT
|
||
2444 05361 5325 FGT X
|
||
2445 05362 7325 FMY X
|
||
2446 05363 7330 FPT XSQR
|
||
2447 05364 7302 FMY BET2
|
||
2448 05365 5277 FAD BET1
|
||
2449 05366 7330 FMY XSQR
|
||
2450 05367 5305 FAD BETZ
|
||
2451 05370 6733 FPT I TP
|
||
2452 05371 5310 FGT ALF2
|
||
2453 05372 7330 FMY XSQR
|
||
2454 05373 5313 FAD ALF1
|
||
2455 05374 7330 FMY XSQR
|
||
2456 05375 5316 FAD ALFZ
|
||
2457 05376 7325 FMY X
|
||
2458 05377 4733 FDV I TP
|
||
2459 05400 0000 FEXT
|
||
2460 05401 2413 ISZ I PDLXR /CHECK SIGN FLAG
|
||
2461 05402 5207 JMP EXIT2
|
||
2462 05403 4450 NEGATE /SUBTRACT FROM PI/2
|
||
2463 05404 4407 FENT
|
||
2464 05405 5413 FAD PIOT
|
||
2465 05406 0000 FEXT
|
||
2466 05407 2010 EXIT2, ISZ SN /ARC TAN(-X)=-ARC TAN(X)
|
||
2467 05410 5500 RETURN
|
||
2468 05411 4450 NEGATE
|
||
2469 05412 5500 RETURN
|
||
2470 /ARCTANGENT AND LOG CONSTANTS AND POINTERS
|
||
2471 05413 0001 PIOT, 0001 /PI/2
|
||
2472 05414 3110 3110
|
||
2473 05415 3761 3761
|
||
2474 05416 7771 L8, 7771
|
||
2475 05417 4544 4544
|
||
2476 05420 1735 1735
|
||
2477 05421 7774 L7, 7774
|
||
2478 05422 2236 2236
|
||
2479 05423 4304 4304
|
||
2480 05424 7775 L6, 7775
|
||
2481 05425 4746 4746
|
||
2482 05426 0771 0771
|
||
2483 05427 7776 L5, 7776
|
||
2484 05430 2535 2535
|
||
2485 05431 3301 3301
|
||
2486 05432 7776 L4, 7776
|
||
2487 05433 4113 4113
|
||
2488 05434 7211 7211
|
||
2489 05435 7777 L3, 7777
|
||
2490 05436 2517 2517
|
||
2491 05437 0307 0307
|
||
2492 05440 7777 L2, 7777
|
||
2493 05441 4000 4000
|
||
2494 05442 4100 4100
|
||
2495 05443 0000 L1, 0000
|
||
2496 05444 3777 3777
|
||
2497 05445 7742 7742
|
||
2498 05446 0000 LOGE2, 0000
|
||
2499 05447 2613 2613
|
||
2500 05450 4414 4414
|
||
2501 05451 7545 TP1, FLTEMP
|
||
2502 05452 1573 ONEP2, FLTONE
|
||
2503 05453 5325 X1, X
|
||
2504 / LOGARITHM
|
||
2505 05454 1045 FLOG, GETSGN
|
||
2506 05455 7550 SPA SNA
|
||
2507 05456 4526 ERROR /ZERO OR NEGATIVE ARGUMENT
|
||
2508 05457 4407 FENT
|
||
2509 05460 6651 FPT I TP1
|
||
2510 05461 2652 FSB I ONEP2
|
||
2511 05462 0000 FEXT
|
||
2512 05463 1045 GETSGN
|
||
2513 05464 7450 SNA
|
||
2514 05465 5336 JMP ZERGO /LOG(1)=0
|
||
2515 05466 7700 SMA CLA
|
||
2516 05467 5276 JMP STARTL
|
||
2517 05470 4407 FENT /LOG(X)=-LOG(1/X)
|
||
2518 05471 5652 FGT I ONEP2
|
||
2519 05472 4651 FDV I TP1
|
||
2520 05473 6651 FPT I TP1
|
||
2521 05474 0000 FEXT
|
||
2522 05475 7040 CMA
|
||
2523 05476 3010 STARTL, DCA SN
|
||
2524 05477 7040 CMA
|
||
2525 05500 1651 TAD I TP1
|
||
2526 05501 4430 FLOAT
|
||
2527 05502 4407 FENT
|
||
2528 05503 7446 FMY LOGE2
|
||
2529 05504 6653 FPT I X1
|
||
2530 05505 0000 FEXT
|
||
2531 05506 7001 IAC
|
||
2532 05507 3651 DCA I TP1
|
||
2533 05510 4407 FENT
|
||
2534 05511 5651 FGT I TP1
|
||
2535 05512 2652 FSB I ONEP2
|
||
2536 05513 6651 FPT I TP1
|
||
2537 05514 7416 FMY L8
|
||
2538 05515 5421 FAD L7
|
||
2539 05516 3651 FMY I TP1
|
||
2540 05517 5424 FAD L6
|
||
2541 05520 3651 FMY I TP1
|
||
2542 05521 5427 FAD L5
|
||
2543 05522 3651 FMY I TP1
|
||
2544 05523 5432 FAD L4
|
||
2545 05524 3651 FMY I TP1
|
||
2546 05525 5435 FAD L3
|
||
2547 05526 3651 FMY I TP1
|
||
2548 05527 5440 FAD L2
|
||
2549 05530 3651 FMY I TP1
|
||
2550 05531 5443 FAD L1
|
||
2551 05532 3651 FMY I TP1
|
||
2552 05533 1653 FAD I X1
|
||
2553 05534 0000 FEXT
|
||
2554 05535 5207 JMP EXIT2
|
||
2555 05536 4430 ZERGO, FLOAT
|
||
2556 05537 5500 RETURN
|
||
2557 /CONTINUATION OF SINE ROUTINE
|
||
2558 05540 4407 PALG, FENT
|
||
2559 05541 5653 FGT I X1
|
||
2560 05542 5413 FDV PIOT
|
||
2561 05543 6653 FPT I X1
|
||
2562 05544 3653 FMY I X1
|
||
2563 05545 6651 FPT I TP1
|
||
2564 05546 7561 FMY C9
|
||
2565 05547 5564 FAD C7
|
||
2566 05550 3651 FMY I TP1
|
||
2567 05551 5567 FAD C5
|
||
2568 05552 3651 FMY I TP1
|
||
2569 05553 5572 FAD C3
|
||
2570 05554 3651 FMY I TP1
|
||
2571 05555 5413 FAD PIOT
|
||
2572 05556 3653 FMY I X1
|
||
2573 05557 0000 FEXT
|
||
2574 05560 5207 JMP EXIT2
|
||
2575 /SINE CONSTANTS
|
||
2576 05561 7764 C9, 7764
|
||
2577 05562 2366 2366
|
||
2578 05563 5735 5735
|
||
2579 05564 7771 C7, 7771
|
||
2580 05565 5466 5466
|
||
2581 05566 6317 6317
|
||
2582 05567 7775 C5, 7775
|
||
2583 05570 2431 2431
|
||
2584 05571 5053 5053
|
||
2585 05572 0000 C3, 0000
|
||
2586 05573 5325 5325
|
||
2587 05574 0420 0420
|
||
2588
|
||
2589 /***** FLOAT -- FOR FOCAL 5/69 *****
|
||
2590 /E.A.TAFT 25-JUL-72
|
||
2591 *5600
|
||
2592 /DECIMAL TO BINARY CONVERSION 2/10/69
|
||
2593 05600 0000 DBCONV, 0
|
||
2594 05601 4430 FLOAT /FLOAT A ZERO
|
||
2595 05602 3364 DCA DECEXP /INITIALIZE
|
||
2596 05603 7040 CMA
|
||
2597 05604 3260 DCA PSWIT
|
||
2598 05605 1363 TAD C43 /35(10)
|
||
2599 05606 3044 DCA FLAC0
|
||
2600 05607 4755 JMS I SGNTST /SIGN OF MANTISSA
|
||
2601 05610 3365 DCA INSIGN
|
||
2602 05611 5215 JMP NEWDIG+1
|
||
2603 05612 2260 PERIOD, ISZ PSWIT /. FOUND, SEE IF FIRST
|
||
2604 05613 4526 ERROR /DOUBLE PERIODS
|
||
2605 05614 4506 NEWDIG, GETC /LOOK FOR A DIGIT
|
||
2606 05615 4522 TESTN
|
||
2607 05616 5212 JMP PERIOD /. FOUND
|
||
2608 05617 5250 JMP NOTDIG /NOT FOUND
|
||
2609 05620 1260 TAD PSWIT /DECREMENT DECIMAL EXPONENT
|
||
2610 05621 7700 SMA CLA /IF AFTER .
|
||
2611 05622 7040 CMA
|
||
2612 05623 1364 TAD DECEXP
|
||
2613 05624 3364 DCA DECEXP
|
||
2614 05625 4342 JMS MULT10 /MULTIPLY FLAC BY 10
|
||
2615 05626 1127 TAD SORTCN /ADD NEW DIGIT
|
||
2616 05627 3043 DCA FLOP3
|
||
2617 05630 3042 DCA FLOP2
|
||
2618 05631 3041 DCA FLOP1
|
||
2619 05632 4313 JMS TRPLAD
|
||
2620 05633 1162 OVCHEK, TAD REMAIN /CHECK FOR OVERFLOW
|
||
2621 05634 7640 SZA CLA
|
||
2622 05635 5241 JMP .+4
|
||
2623 05636 1045 TAD FLAC1
|
||
2624 05637 7700 SMA CLA
|
||
2625 05640 5214 JMP NEWDIG /NO OVERFLOW
|
||
2626 05641 1361 TAD IOVRL /OVERFLOW, ROTATE RIGHT
|
||
2627 05642 3760 DCA I IRARAC /SET UP RETURN TO OVCHEK
|
||
2628 05643 1162 TAD REMAIN /ROTATE REMAIN
|
||
2629 05644 7110 CLL RAR
|
||
2630 05645 3162 DCA REMAIN
|
||
2631 05646 1045 TAD FLAC1
|
||
2632 05647 5762 JMP I ROTRAC /ROTATE REST OF FLAC
|
||
2633
|
||
2634 05650 4511 NOTDIG, SORTC /TEST FOR LETTER E
|
||
2635 05651 6145 C305-1
|
||
2636 05652 5301 JMP EINPUT /FOUND E
|
||
2637 05653 2365 DBTERM, ISZ INSIGN /END OF INPUT, AFFIX SIGN
|
||
2638 05654 4450 NEGATE
|
||
2639 05655 1366 TAD CFNR /SET UP TO NORMALIZE
|
||
2640 05656 3260 DBLOOP, DCA .+2
|
||
2641 05657 4407 FENT
|
||
2642 05660 7000 PSWIT, FNR /OR FMY BY 10 OR .10
|
||
2643 05661 6554 FPT I PT1 /SAVE RESULT
|
||
2644 05662 0000 FEXT
|
||
2645 05663 1364 TAD DECEXP /CHECK DECIMAL EXPONENT
|
||
2646 05664 7450 SNA
|
||
2647 05665 5600 JMP I DBCONV /DONE
|
||
2648 05666 7500 SMA
|
||
2649 05667 5273 JMP .+4
|
||
2650 05670 7001 IAC /NEGATIVE, SET UP TO FMY BY .10
|
||
2651 05671 3364 DCA DECEXP
|
||
2652 05672 5277 JMP .+5
|
||
2653 05673 7240 CLA CMA /POSITIVE, SET UP TO FMY BY 10
|
||
2654 05674 1364 TAD DECEXP
|
||
2655 05675 3364 DCA DECEXP
|
||
2656 05676 1066 TAD M3
|
||
2657 05677 1367 TAD FLINST /INSTRUCTION FMY FLTEN OR FLPTEN
|
||
2658 05700 5256 JMP DBLOOP
|
||
2659 05701 4506 EINPUT, GETC /FOUND "E"
|
||
2660 05702 4755 JMS I SGNTST /TEST FOR SIGN
|
||
2661 05703 3040 DCA FLOP0
|
||
2662 05704 4757 JMS I DECIN1 /INPUT A DECIMAL INTEGER
|
||
2663 05705 1164 TAD DECNUM
|
||
2664 05706 2040 ISZ FLOP0 /CHECK SIGN
|
||
2665 05707 7041 CIA
|
||
2666 05710 1364 TAD DECEXP
|
||
2667 05711 3364 DCA DECEXP
|
||
2668 05712 5253 JMP DBTERM
|
||
2669 /ADD FLOP TO FLAC TRIPLE PRECISION WITH OVERFLOW
|
||
2670 05713 0000 TRPLAD, 0
|
||
2671 05714 7300 CLA CLL
|
||
2672 05715 1043 TAD FLOP3
|
||
2673 05716 1047 TAD FLAC3
|
||
2674 05717 3047 DCA FLAC3
|
||
2675 05720 7004 RAL
|
||
2676 05721 1042 TAD FLOP2
|
||
2677 05722 1046 TAD FLAC2
|
||
2678 05723 3046 DCA FLAC2
|
||
2679 05724 7004 RAL
|
||
2680 05725 1041 TAD FLOP1
|
||
2681 05726 1045 TAD FLAC1
|
||
2682 05727 3045 DCA FLAC1
|
||
2683 05730 7004 RAL
|
||
2684 05731 1162 TAD REMAIN
|
||
2685 05732 3162 DCA REMAIN
|
||
2686 05733 5713 JMP I TRPLAD
|
||
2687 /MULTIPLY FLAC BY 2
|
||
2688 05734 0000 MULT2, 0
|
||
2689 05735 4756 JMS I MULT2I
|
||
2690 05736 1162 TAD REMAIN
|
||
2691 05737 7004 RAL
|
||
2692 05740 3162 DCA REMAIN
|
||
2693 05741 5734 JMP I MULT2
|
||
2694 /MULTIPLY FLAC BY 10
|
||
2695 05742 0000 MULT10, 0
|
||
2696 05743 4504 PUSHF /FLAC=>FLOP
|
||
2697 05744 0045 FLAC1
|
||
2698 05745 4505 POPF
|
||
2699 05746 0041 FLOP1
|
||
2700 05747 3162 DCA REMAIN /CLEAR OVERFLOW
|
||
2701 05750 4334 JMS MULT2 /FLAC*10 = (FLAC*2*2+FLAC)*2
|
||
2702 05751 4334 JMS MULT2
|
||
2703 05752 4313 JMS TRPLAD
|
||
2704 05753 4334 JMS MULT2
|
||
2705 05754 5742 JMP I MULT10
|
||
2706 05755 6030 SGNTST, TSTSGN
|
||
2707 05756 7037 MULT2I, RALAC
|
||
2708 05757 6010 DECIN1, DECINT
|
||
2709 05760 7251 IRARAC, RARAC
|
||
2710 05761 5633 IOVRL, OVCHEK
|
||
2711 05762 7256 ROTRAC, RARAC+5
|
||
2712 05763 0043 C43, 43
|
||
2713 05764 0000 DECEXP, 0 /IMPLICIT DECIMAL EXPONENT
|
||
2714 05765 0000 INSIGN, 0 /SIGN OF MANTISSA
|
||
2715 05766 7000 CFNR, FNR
|
||
2716 05767 7773 FLINST, FMY .+4
|
||
2717 05770 0004 FLTEN, 0004 /10(10) FLOATING
|
||
2718 05771 2400 2400
|
||
2719 05772 0000 0000
|
||
2720 05773 7775 FLPTEN, 7775 /.10(10) FLOATING
|
||
2721 05774 3146 3146
|
||
2722 05775 3147 3147
|
||
2723 REMAIN=TEMP1
|
||
2724 /CHARACTER LIST FOR "ASK"
|
||
2725 05776 0215 ASKLST, 215 /CR
|
||
2726 05777 0214 214 /FF
|
||
2727 06000 0337 337 /BA
|
||
2728 06001 0254 254 /COMMA
|
||
2729 06002 0000 USERT, 0 /USER-SELECTED CHARACTER
|
||
2730 06003 0212 212 /LF
|
||
2731 /POWER OF 10 TABLE
|
||
2732 06004 6030 INTABL, -1750 /1000
|
||
2733 06005 7634 -144 /100
|
||
2734 06006 7766 -12 /10
|
||
2735 06007 7777 -1 /1
|
||
2736 /INPUT A DECIMAL INTEGER <2048
|
||
2737 06010 0000 DECINT, 0
|
||
2738 06011 3164 DCA DECNUM
|
||
2739 06012 4522 TESTN /GET A DIGIT
|
||
2740 06013 7000 NOP
|
||
2741 06014 5610 JMP I DECINT /NONE FOUND
|
||
2742 06015 4506 GETC
|
||
2743 06016 1164 TAD DECNUM /MULTIPLY PREV. # BY 10
|
||
2744 06017 7106 CLL RTL
|
||
2745 06020 7530 SPA SZL
|
||
2746 06021 5226 JMP .+5 /OVERFLOW (>2047)
|
||
2747 06022 1164 TAD DECNUM
|
||
2748 06023 7004 RAL
|
||
2749 06024 1127 TAD SORTCN /ADD NEW DIGIT
|
||
2750 06025 7530 SPA SZL
|
||
2751 06026 4526 ERROR
|
||
2752 06027 5211 JMP DECINT+1
|
||
2753 DECNUM=TEMP3
|
||
2754 /TEST FOR A SIGN
|
||
2755 06030 0000 TSTSGN, 0
|
||
2756 06031 4521 SPNOR
|
||
2757 06032 3127 DCA SORTCN
|
||
2758 06033 4511 SORTC /LOOK FOR + OR -
|
||
2759 06034 6114 SNLIST-1
|
||
2760 06035 4506 GETC /SIGN FOUND
|
||
2761 06036 4521 SPNOR /NOT FOUND
|
||
2762 06037 7240 CLA CMA
|
||
2763 06040 1127 TAD SORTCN /SORTCN: 0=+, 1=-
|
||
2764 06041 5630 JMP I TSTSGN /AC: 7777=+, 0=-
|
||
2765 DIGIT=TEMP2
|
||
2766 /PRINT A 2-4 DIGIT UNSIGNED DECIMAL INTEGER
|
||
2767 /FIRST 2 LEADING ZEROES NOT PRINTED
|
||
2768 06042 0000 INTOUT, 0
|
||
2769 06043 3164 DCA DECNUM
|
||
2770 06044 1314 TAD INTPTR /POWER OF 10 POINTER
|
||
2771 06045 3260 DCA INTSUB
|
||
2772 06046 3210 DCA DECINT /DECINT=0 MEANS SKIP 0 OUTPUT
|
||
2773 06047 4255 JMS INTDO /1ST DIGIT (1000S)
|
||
2774 06050 4255 JMS INTDO /2ND DIGIT (100S)
|
||
2775 06051 2210 ISZ DECINT /DECINT>0 MEANS PRINT 0S
|
||
2776 06052 4255 JMS INTDO /3RD DIGIT (10S)
|
||
2777 06053 4255 JMS INTDO /4TH DIGIT (UNITS)
|
||
2778 06054 5642 JMP I INTOUT
|
||
2779 06055 0000 INTDO, 0
|
||
2780 06056 3163 DCA DIGIT /INITIALIZE
|
||
2781 06057 1164 TAD DECNUM
|
||
2782 06060 1204 INTSUB, TAD INTABL /SUBTRACT A POWER OF 10
|
||
2783 06061 7510 SPA
|
||
2784 06062 5267 JMP INTNEG
|
||
2785 06063 3164 DCA DECNUM /POSITIVE RESULT
|
||
2786 06064 2163 ISZ DIGIT /NONZERO DIGIT, SO IGNORE NO
|
||
2787 06065 2210 ISZ DECINT /FURTHER ZEROES
|
||
2788 06066 5257 JMP INTSUB-1
|
||
2789 06067 7300 INTNEG, CLA CLL /NEGATIVE RESULT
|
||
2790 06070 2260 ISZ INTSUB /SET UP NEXT POWER OF 10
|
||
2791 06071 1210 TAD DECINT /IS IT A LEADING 0?
|
||
2792 06072 7650 SNA CLA
|
||
2793 06073 5655 JMP I INTDO /YES, SKIP IT
|
||
2794 06074 1163 TAD DIGIT /NO, PRINT DIGIT
|
||
2795 06075 1036 TAD C260
|
||
2796 06076 4512 PRINTC
|
||
2797 06077 5655 JMP I INTDO
|
||
2798 /OUTPUT A SIGNED INTEGER IN AC
|
||
2799 06100 0000 SIGOUT, 0
|
||
2800 06101 3164 DCA DECNUM /SAVE NUMBER
|
||
2801 06102 1164 TAD DECNUM
|
||
2802 06103 7710 SPA CLA
|
||
2803 06104 1035 TAD P2 /MAKE A -
|
||
2804 06105 1315 TAD C253 /MAKE A +
|
||
2805 06106 4512 PRINTC
|
||
2806 06107 1164 TAD DECNUM /OUTPUT ABSOLUTE VALUE
|
||
2807 06110 7510 SPA
|
||
2808 06111 7041 CIA
|
||
2809 06112 4242 JMS INTOUT /OUTPUT THE NUMBER
|
||
2810 06113 5700 JMP I SIGOUT
|
||
2811 06114 1204 INTPTR, TAD INTABL
|
||
2812 SNLIST=. /FOR SIGN TESTING
|
||
2813 06115 0253 C253, 253 /+
|
||
2814 06116 0255 255 /-
|
||
2815 /E FORMAT OUTPUT ROUTINE
|
||
2816 06117 7200 XXX, CLA /CONVERT TO E FORMAT ON OVERFLOW
|
||
2817 06120 1051 TAD TOTDIG
|
||
2818 06121 7410 SKP
|
||
2819 06122 1133 FLOUT, TAD DECP /E FORMAT (%0) FLOATING OUTPUT
|
||
2820 06123 7041 CIA
|
||
2821 06124 7450 SNA
|
||
2822 06125 1347 TAD MDIG /6 DIGITS IF 0 GIVEN
|
||
2823 06126 3164 DCA DECNUM /DIGIT COUNTER
|
||
2824 06127 1022 TAD PER /PERIOD
|
||
2825 06130 4512 PRINTC
|
||
2826 06131 1412 FLDIG, TAD I XRT2 /NEXT DIGIT
|
||
2827 06132 2157 ISZ T2 /OUT OF SIG DIGITS?
|
||
2828 06133 5336 JMP .+3 /NO, PRINT DIGIT
|
||
2829 06134 7240 CLA CMA /YES, RESET POINTER AND PRINT 0
|
||
2830 06135 3157 DCA T2
|
||
2831 06136 4750 JMS I OUTP
|
||
2832 06137 7410 SKP /FIELD NOW FILLED, PRINT EXPONENT
|
||
2833 06140 5331 JMP FLDIG
|
||
2834 /B-D CONV EXPONENT OUTPUT
|
||
2835 06141 1346 TAD C305 /PRINT LETTER E
|
||
2836 06142 4512 PRINTC
|
||
2837 06143 1156 TAD T1 /OUTPUT THE EXPONENT
|
||
2838 06144 4300 JMS SIGOUT
|
||
2839 06145 5770 BDEND, JMP I BDCONV /DONE
|
||
2840 06146 0305 C305, 305 /E
|
||
2841 06147 7772 MDIG, -DIGITS
|
||
2842 06150 6437 OUTP, OUTA
|
||
2843 /PRINT A LINE NUMBER - "PRNTLN"
|
||
2844 06151 0000 XPRNTL, 0
|
||
2845 06152 1143 TAD LINENO
|
||
2846 06153 4520 RTL6
|
||
2847 06154 0071 AND P77
|
||
2848 06155 4242 JMS INTOUT /2-DIGIT PART NUMBER
|
||
2849 06156 1022 TAD PER
|
||
2850 06157 4512 PRINTC /DECIMAL POINT
|
||
2851 06160 1143 TAD LINENO
|
||
2852 06161 0026 AND P177 /2-DIGIT STEP NUMBER
|
||
2853 06162 4242 JMS INTOUT
|
||
2854 06163 1033 TAD C240 /SPACE
|
||
2855 06164 3142 DCA CHAR
|
||
2856 06165 4512 PRINTC
|
||
2857 06166 5751 JMP I XPRNTL
|
||
2858
|
||
2859 06167 0015 NEGSGN, 255-240
|
||
2860 /BINARY TO DECIMAL CONVERSION AND OUTPUT
|
||
2861 06170 0000 BDCONV, 0
|
||
2862 06171 1045 TAD FLAC1 /CHECK SIGN
|
||
2863 06172 7700 SMA CLA
|
||
2864 06173 5376 JMP .+3
|
||
2865 06174 4450 NEGATE /NEGATIVE, TAKE ABSOLUTE VALUE
|
||
2866 06175 1367 TAD NEGSGN /MAKE A -
|
||
2867 06176 1033 TAD C240 /MAKE A SPACE
|
||
2868 06177 4512 PRINTC
|
||
2869 06200 7240 CLA CMA /DECREMENT BINARY EXPONENT
|
||
2870 06201 1044 TAD FLAC0
|
||
2871 06202 3044 DCA FLAC0
|
||
2872 06203 3156 BDSCAL, DCA T1 /INITIALIZE DECIMAL EXPONENT
|
||
2873 06204 1044 TAD FLAC0 /START SCALING: -4<EXP<0?
|
||
2874 06205 7500 SMA
|
||
2875 06206 5220 JMP SDOWN /TOO BIG, SCALE DOWN
|
||
2876 06207 1631 TAD I TENPT
|
||
2877 06210 7700 SMA CLA
|
||
2878 06211 5244 JMP SCALED /WITHIN LIMITS, DONE
|
||
2879 06212 4407 FENT /TOO SMALL, SCALE UP
|
||
2880 06213 3631 FMY I TENPT
|
||
2881 06214 0000 FEXT
|
||
2882 06215 7240 CLA CMA
|
||
2883 06216 1156 TAD T1 /DECREMENT DECIMAL EXPONENT
|
||
2884 06217 5203 JMP BDSCAL
|
||
2885 06220 4407 SDOWN, FENT /SCALE DOWN
|
||
2886 06221 3632 FMY I PTENPT
|
||
2887 06222 0000 FEXT
|
||
2888 06223 7001 IAC /INCREMENT DECIMAL EXPONENT
|
||
2889 06224 5216 JMP .-6
|
||
2890 /CONSTANTS
|
||
2891 06225 7771 DCOUNT, -DIGITS-1
|
||
2892 06226 7772 MDIGIT, -DIGITS
|
||
2893 06227 0007 RND2, DIGITS+1
|
||
2894 06230 7766 M12, -12
|
||
2895 /POINTERS
|
||
2896 06231 5770 TENPT, FLTEN
|
||
2897 06232 5773 PTENPT, FLPTEN
|
||
2898 06233 5734 MULT2P, MULT2
|
||
2899 06234 5742 MUL10P, MULT10
|
||
2900 06235 7544 BUFST, DIGBUF-1
|
||
2901 06236 6122 FLOUTP, FLOUT
|
||
2902 06237 6117 XXXP, XXX
|
||
2903 /ROUTINE TO DECREMENT THE DIGIT POINTER
|
||
2904 06240 7040 DECR, CMA
|
||
2905 06241 1040 TAD FLOP0
|
||
2906 06242 3040 DCA FLOP0
|
||
2907 06243 5351 JMP RET
|
||
2908 /FINISHED SCALING, GENERATE DIGITS
|
||
2909 06244 4633 SCALED, JMS I MULT2P /ROTATE FLAC LEFT
|
||
2910 06245 1235 TAD BUFST /INITIALIZE DIGIT BUFFER
|
||
2911 06246 3012 DCA XRT2
|
||
2912 06247 4634 JMS I MUL10P /MULTIPLY BY 10
|
||
2913 06250 1162 TAD REMAIN /OVERFLOW
|
||
2914 06251 5266 JMP BDC1
|
||
2915 06252 7110 BDC0, CLL RAR
|
||
2916 06253 3004 DCA FNEGSW /TEMP STORAGE OF FIRST DIGIT
|
||
2917 06254 1045 TAD FLAC1 /ROTATE FLAC RIGHT
|
||
2918 06255 7010 RAR
|
||
2919 06256 3045 DCA FLAC1
|
||
2920 06257 1046 TAD FLAC2
|
||
2921 06260 7010 RAR
|
||
2922 06261 3046 DCA FLAC2
|
||
2923 06262 1047 TAD FLAC3
|
||
2924 06263 7010 RAR
|
||
2925 06264 3047 DCA FLAC3
|
||
2926 06265 1004 TAD FNEGSW /PREV. OVERFLOW
|
||
2927 06266 2044 BDC1, ISZ FLAC0 /CHECK ROTATE COUNT
|
||
2928 06267 5252 JMP BDC0
|
||
2929 06270 7440 SZA
|
||
2930 06271 5301 JMP BDC2
|
||
2931 06272 7240 CLA CMA /FIRST DIGIT IS 0, IGNORE
|
||
2932 06273 1156 TAD T1 /DECREMENT DECIMAL EXPONENT
|
||
2933 06274 3156 DCA T1
|
||
2934 06275 1045 TAD FLAC1
|
||
2935 06276 7650 SNA CLA
|
||
2936 06277 3156 DCA T1 /EXP=0 IF MANTISSA=0
|
||
2937 06300 7410 SKP
|
||
2938 06301 3412 BDC2, DCA I XRT2 /FIRST DIGIT WAS NOT 0
|
||
2939 06302 1225 TAD DCOUNT /SET TO COUNT DIGITS
|
||
2940 06303 3044 DCA FLAC0
|
||
2941 06304 4634 JMS I MUL10P /MULTIPLY BY 10
|
||
2942 06305 1162 TAD REMAIN
|
||
2943 06306 3412 DCA I XRT2 /SAVE DIGIT JUST GENERATED
|
||
2944 06307 2044 ISZ FLAC0
|
||
2945 06310 5304 JMP .-4
|
||
2946 06311 1235 TAD BUFST /REINITIALIZE POINTER
|
||
2947 06312 3012 DCA XRT2
|
||
2948 06313 1225 TAD DCOUNT /DIGITS AVAILABLE
|
||
2949 06314 3157 DCA T2
|
||
2950 06315 1051 TAD TOTDIG /DIGITS WANTED
|
||
2951 06316 7450 SNA
|
||
2952 06317 5340 JMP R6 /E FORMAT, ROUND TO 6 PLACES
|
||
2953 06320 7041 CIA /COMPUTE FIELD SIZES
|
||
2954 06321 1133 TAD DECP
|
||
2955 06322 7550 SPA SNA
|
||
2956 06323 5327 JMP .+4 /COMPARE DECP TO TOTDIG
|
||
2957 06324 7200 CLA /MORE DECP THAN TOTAL DIGITS!
|
||
2958 06325 1051 TAD TOTDIG
|
||
2959 06326 3133 DCA DECP
|
||
2960 06327 1156 TAD T1 /COMPARE EXPONENT TO FIELD SIZE
|
||
2961 06330 7500 SMA
|
||
2962 06331 7200 CLA /INTEGER FIELD >= EXPONENT
|
||
2963 06332 1051 TAD TOTDIG
|
||
2964 06333 7510 SPA
|
||
2965 06334 5362 JMP FPRNT-2 /NO ROUNDING NEEDED
|
||
2966 06335 1226 TAD MDIGIT /ROUND TO DECP+EXP PLACES
|
||
2967 06336 7500 SMA
|
||
2968 06337 7200 CLA
|
||
2969 06340 1227 R6, TAD RND2 /START ROUNDING
|
||
2970 06341 3004 DCA FNEGSW /PLACES TO ROUND TO
|
||
2971 06342 1235 TAD BUFST /ROUNDING START ADDRESS
|
||
2972 06343 1004 TAD FNEGSW /SET UP ROUND COUNT
|
||
2973 06344 3040 DCA FLOP0
|
||
2974 06345 1004 TAD FNEGSW
|
||
2975 06346 7041 CIA
|
||
2976 06347 3004 DCA FNEGSW /START ROUNDING PROCESS BY
|
||
2977 06350 1631 TAD I TENPT /ADDING 4 TO FIRST DIGIT
|
||
2978 06351 2440 RET, ISZ I FLOP0 /INCREMENT CURRENT DIGIT
|
||
2979 06352 1440 TAD I FLOP0
|
||
2980 06353 1230 TAD M12
|
||
2981 06354 7710 SPA CLA /DIGIT>9?
|
||
2982 06355 5364 JMP FPRNT /NO, END ROUNDING
|
||
2983 06356 3440 DCA I FLOP0 /YES, SET DIGIT TO 0 AND CARRY
|
||
2984 06357 2004 ISZ FNEGSW /BEGINNING OF BUFFER?
|
||
2985 06360 5240 JMP DECR /NO DECREMENT BUFFER ADDRESS
|
||
2986 06361 2440 ISZ I FLOP0 /YES, FAKE CARRY FROM FIRST DIGIT
|
||
2987 06362 2156 ISZ T1
|
||
2988 06363 7200 CLA
|
||
2989
|
||
2990 06364 1051 FPRNT, TAD TOTDIG /SET UP FIELD SIZES
|
||
2991 06365 7450 SNA
|
||
2992 06366 5636 JMP I FLOUTP /E FORMAT OUTPUT
|
||
2993 06367 7041 CIA
|
||
2994 06370 3164 DCA DECNUM /NUMBER OF PLACES TO PRINT
|
||
2995 06371 1164 TAD DECNUM
|
||
2996 06372 1156 TAD T1
|
||
2997 06373 7540 SMA SZA
|
||
2998 06374 5637 JMP I XXXP /TOO BIG, PRINT E FORMAT
|
||
2999 06375 1133 TAD DECP /OK, TEST DECIMAL PLACES
|
||
3000 06376 7500 SMA
|
||
3001 06377 7200 CLA /ADJUST DECIMAL POINT
|
||
3002 06400 7041 CIA
|
||
3003 06401 1156 TAD T1
|
||
3004 06402 7141 CLL CIA
|
||
3005 06403 3004 DCA FNEGSW /NUMBER OF INTEGER PLACES
|
||
3006 06404 7430 SZL
|
||
3007 06405 5222 JMP IN+4 /NO INTEGER PLACES
|
||
3008 /START PRINTING
|
||
3009 06406 1156 BACK, TAD T1
|
||
3010 06407 1004 TAD FNEGSW
|
||
3011 06410 7650 SNA CLA
|
||
3012 06411 5225 JMP DIG /PRINT A DIGIT
|
||
3013 06412 1004 TAD FNEGSW
|
||
3014 06413 7001 IAC
|
||
3015 06414 7710 SPA CLA /PRINT 0 IF ONE INTEGER PLACE LEFT
|
||
3016 06415 1025 TAD M20 /OTHERWISE A SPACE
|
||
3017 06416 4237 IN, JMS OUTA /PRINT A CHARACTER
|
||
3018 06417 5645 JMP I BDENDP /FIELD FILLED, EXIT
|
||
3019 06420 2004 ISZ FNEGSW
|
||
3020 06421 5206 JMP BACK /CONTINUE
|
||
3021 06422 1022 TAD PER /DECIMAL POINT
|
||
3022 06423 4512 PRINTC
|
||
3023 06424 5206 JMP BACK
|
||
3024 06425 7040 DIG, CMA
|
||
3025 06426 1156 TAD T1 /DECREMENT DECIMAL EXPONENT
|
||
3026 06427 3156 DCA T1
|
||
3027 06430 2157 ISZ T2 /CHECK SIG DIGIT COUNT
|
||
3028 06431 5235 JMP .+4 /SOME LEFT
|
||
3029 06432 7040 CMA /ALL USED UP
|
||
3030 06433 3157 DCA T2
|
||
3031 06434 5216 JMP IN /PRINT A 0
|
||
3032 06435 1412 TAD I XRT2 /PRINT A SIG DIGIT
|
||
3033 06436 5216 JMP IN
|
||
3034 /DIGIT PRINT ROUTINE FOR BDCONV
|
||
3035 06437 0000 OUTA, 0
|
||
3036 06440 1036 TAD C260 /CONVERT TO ASCII
|
||
3037 06441 4512 PRINTC
|
||
3038 06442 2164 ISZ DECNUM /FIELD FILLED?
|
||
3039 06443 2237 ISZ OUTA /NO, GO TO SECOND RETURN
|
||
3040 06444 5637 JMP I OUTA
|
||
3041 06445 6145 BDENDP, BDEND
|
||
3042 / "OPTION" PROCESSOR
|
||
3043 06446 4521 OPTION, SPNOR /GET OPTION LETTER
|
||
3044 06447 4510 SORTJ
|
||
3045 06450 2377 OPTLST-1
|
||
3046 06451 7574 OPTTBL-OPTLST
|
||
3047 06452 4526 ERROR /ILLEGAL OPTION NAME
|
||
3048 /////
|
||
3049 06453 7240 OPTR, CLA CMA /SWAP INPUT TO HIGH SPEED READER
|
||
3050 06454 3037 DCA HINBUF
|
||
3051 06455 6014 RFC /START READER
|
||
3052 06456 1317 TAD RESTR /POINT TO "HREAD"
|
||
3053 06457 1161 OPTK, TAD PTCH /SWAP TO KEYBOARD IF CALLED HERE
|
||
3054 06460 3113 DCA 113
|
||
3055 /////
|
||
3056 06461 4565 OPTRET, TSTERM /MOVE TO ,;CR
|
||
3057 06462 5261 JMP .-1
|
||
3058 06463 5665 JMP I .+2 /END OF OPTIONS
|
||
3059 06464 5246 JMP OPTION /CONTINUE PROCESSING OPTIONS
|
||
3060 06465 0616 PROC
|
||
3061 /////
|
||
3062 /HIGH SPEED INPUT ROUTINE
|
||
3063 06466 0000 HREAD, 0
|
||
3064 06467 1067 TAD M5
|
||
3065 06470 3156 DCA T1
|
||
3066 06471 3157 DCA T2
|
||
3067 06472 6001 HREAD2, ION /(SWAP) - FOR 2-USER
|
||
3068 06473 1037 TAD HINBUF /WAIT FOR INPUT
|
||
3069 06474 7700 SMA CLA
|
||
3070 06475 5306 JMP HSGO+1
|
||
3071 06476 2157 ISZ T2
|
||
3072 06477 5272 JMP HREAD2
|
||
3073 06500 2156 ISZ T1
|
||
3074 06501 5272 JMP HREAD2
|
||
3075 06502 1161 TAD PTCH /ALL DONE READING TAPE
|
||
3076 06503 3113 DCA 113 /SWAP TO KEYBOARD INPUT
|
||
3077 06504 1054 TAD P337 /RETURN A B.A. TO KILL UNENDED LINE OR GARBAGE
|
||
3078 /CHARACTER
|
||
3079 06505 5315 HSGO, JMP RESTR-2
|
||
3080 06506 7040 CMA
|
||
3081 06507 3037 DCA HINBUF /SET TO READ NEXT
|
||
3082 06510 6016 RRB RFC
|
||
3083 06511 0026 AND P177 /IGNORE PARITY AND BLANK
|
||
3084 06512 7450 SNA
|
||
3085 06513 5267 JMP HREAD+1
|
||
3086 06514 1015 TAD C200
|
||
3087 06515 3142 DCA CHAR
|
||
3088 06516 5666 JMP I HREAD
|
||
3089 /////
|
||
3090 06517 4003 RESTR, HREAD-CHIN
|
||
3091
|
||
3092 PAGE
|
||
3093 /FLOATING POINT PACKAGE
|
||
3094 /ARITHMETIC INTERPRETER
|
||
3095 06600 0000 FPNT, 0
|
||
3096 06601 7300 CLA CLL
|
||
3097 06602 1600 TAD I FPNT /FLOATING INSTRUCTION
|
||
3098 06603 7450 SNA
|
||
3099 06604 5600 JMP I FPNT /FEXT
|
||
3100 06605 0015 AND C200 /GET PAGE BIT
|
||
3101 06606 7640 SZA CLA
|
||
3102 06607 1200 TAD FPNT /CURRENT PAGE
|
||
3103 06610 0024 AND P7600
|
||
3104 06611 3231 DCA FLADDR /START ADDRESS OF ADDRESSED PAGE
|
||
3105 06612 1600 TAD I FPNT /GET ADDRESS BITS
|
||
3106 06613 0026 AND P177
|
||
3107 06614 1231 TAD FLADDR
|
||
3108 06615 3231 DCA FLADDR /FULL 12-BIT ADDRESS
|
||
3109 06616 1600 TAD I FPNT
|
||
3110 06617 2200 ISZ FPNT
|
||
3111 06620 7106 CLL RTL /OP BITS =>AC9-11
|
||
3112 06621 7006 RTL /INDIRECT BIT =>LINK
|
||
3113 06622 0031 AND P17
|
||
3114 06623 1236 TAD DRECTR /SET UP OP POINTER
|
||
3115 06624 3235 DCA DIRECT
|
||
3116 06625 1631 TAD I FLADDR /INDIRECT?
|
||
3117 06626 7430 SZL
|
||
3118 06627 3231 DCA FLADDR /YES
|
||
3119 06630 4504 PUSHF /NO, GET OPERAND
|
||
3120 06631 0000 FLADDR, 0
|
||
3121 06632 4505 POPF
|
||
3122 06633 0040 FLOP
|
||
3123 06634 3043 DCA FLOP3 /CLEAR LOW ORDER OPERAND
|
||
3124 06635 5637 DIRECT, JMP I .+2 /OP DIRECT INSTRUCTION
|
||
3125 06636 5637 DRECTR, JMP I .+1 /OP TABLE
|
||
3126 06637 7406 FLPOW
|
||
3127 06640 6720 FLADD
|
||
3128 06641 6717 FLSUB
|
||
3129 06642 7077 FLMUL
|
||
3130 06643 7171 FLDIV
|
||
3131 06644 6647 FLGET
|
||
3132 06645 6653 FLPUT
|
||
3133 06646 6762 FLNOR
|
||
3134
|
||
3135 06647 4504 FLGET, PUSHF /OP 5: GET FLAC FROM STORAGE
|
||
3136 06650 0040 FLOP
|
||
3137 06651 1254 TAD .+3 /SET UP POINTER TO FLAC
|
||
3138 06652 5256 JMP .+4
|
||
3139 06653 4504 FLPUT, PUSHF /OP 6: PUT FLAC IN STORAGE
|
||
3140 06654 0044 FLAC
|
||
3141 06655 1231 TAD FLADDR /SET UP POINTER TO STORAGE
|
||
3142 06656 3260 DCA .+2
|
||
3143 06657 4505 POPF
|
||
3144 06660 0000 0 /ADDRESS OF STORAGE LOCATION
|
||
3145 06661 5201 JMP FPNT+1
|
||
3146 06662 0000 NEGOP, 0 /ROUTINE TO NEGATE FLOP
|
||
3147 06663 1042 TAD FLOP2
|
||
3148 06664 7141 CLL CIA
|
||
3149 06665 3042 DCA FLOP2
|
||
3150 06666 7024 CML RAL
|
||
3151 06667 1041 TAD FLOP1
|
||
3152 06670 7041 CIA
|
||
3153 06671 3041 DCA FLOP1
|
||
3154 06672 1004 TAD FNEGSW /FNEGSW IS COMPLEMENTED WHEN
|
||
3155 06673 7140 CLL CMA /FLOP OR FLAC IS NEGATED
|
||
3156 06674 3004 DCA FNEGSW
|
||
3157 06675 5662 JMP I NEGOP
|
||
3158 06676 0000 NEGAC, 0 /ROUTINE TO NEGATE FLAC - "NEGATE"
|
||
3159 06677 7300 CLA CLL /TRIPLE PRECISION
|
||
3160 06700 1047 TAD FLAC3
|
||
3161 06701 7041 CIA
|
||
3162 06702 3047 DCA FLAC3
|
||
3163 06703 7024 CML RAL
|
||
3164 06704 1046 TAD FLAC2
|
||
3165 06705 7041 CIA
|
||
3166 06706 3046 DCA FLAC2
|
||
3167 06707 7024 CML RAL
|
||
3168 06710 1045 TAD FLAC1
|
||
3169 06711 7041 CIA
|
||
3170 06712 3045 DCA FLAC1
|
||
3171 06713 1004 TAD FNEGSW
|
||
3172 06714 7140 CLL CMA
|
||
3173 06715 3004 DCA FNEGSW
|
||
3174 06716 5676 JMP I NEGAC
|
||
3175 /ARITHMETIC OPERATIONS
|
||
3176 /BOTH FLAC AND FLOP MUST BE NORMALIZED FOR
|
||
3177 /+-*/^ (FAD,FSU,FMY,FDV,FXP)
|
||
3178 06717 4262 FLSUB, JMS NEGOP /OP 2: SUBTRACT OP (NEGATE AND ADD)
|
||
3179 06720 1045 FLADD, TAD FLAC1 /OP 1: ADD OP
|
||
3180 06721 7650 SNA CLA
|
||
3181 06722 5247 JMP FLGET /RESULT=OPERAND IF FLAC=0
|
||
3182 06723 1041 TAD FLOP1
|
||
3183 06724 7650 SNA CLA
|
||
3184 06725 5201 JMP FPNT+1 /RESULT=FLAC IF FLOP=0
|
||
3185 06726 1040 TAD FLOP0 /COMPARE EXPONENTS
|
||
3186 06727 7041 CIA
|
||
3187 06730 1044 TAD FLAC0
|
||
3188 06731 7450 SNA
|
||
3189 06732 5357 JMP CMBINE /EQUAL, GO ADD TOGETHER
|
||
3190 06733 7500 SMA /NOT EQUAL, NEED SHIFTING
|
||
3191 06734 5346 JMP SHFLOP /FLAC>FLOP, SHIFT FLOP
|
||
3192 06735 1365 TAD P27 /FLAC<FLOP, SHIFT FLAC
|
||
3193 06736 7510 SPA
|
||
3194 06737 5247 JMP FLGET /TOO FAR TO SHIFT, TREAT AS IF FLAC=0
|
||
3195 06740 1364 TAD M27
|
||
3196 06741 3235 DCA DIRECT /NUMBER OF PLACES TO SHIFT
|
||
3197 06742 4767 JMS I RARAC1 /SHIFT FLAC 1 TO RIGHT
|
||
3198 06743 2235 ISZ DIRECT
|
||
3199 06744 5342 JMP .-2
|
||
3200 06745 5357 JMP CMBINE /NUMBERS NOW ALIGNED
|
||
3201 06746 7041 SHFLOP, CIA /ROUTINE TO SHIFT FLOP
|
||
3202 06747 1365 TAD P27
|
||
3203 06750 7510 SPA
|
||
3204 06751 5201 JMP FPNT+1 /FLOP TOO SMALL, TREAT AS 0
|
||
3205 06752 1364 TAD M27
|
||
3206 06753 3235 DCA DIRECT
|
||
3207 06754 4766 JMS I RAROP1 /SHIFT FLOP 1 TO RIGHT
|
||
3208 06755 2235 ISZ DIRECT
|
||
3209 06756 5354 JMP .-2
|
||
3210 06757 4767 CMBINE, JMS I RARAC1 /NOW SHIFT BOTH TO PREVENT OVERFLOW
|
||
3211 06760 4766 JMS I RAROP1
|
||
3212 06761 4770 JMS I FLAD3 /ADD TRIPLE PRECISION
|
||
3213 06762 4771 FLNOR, JMS I NORF /OP 7: NORMALIZE FLAC
|
||
3214 06763 5201 JMP FPNT+1
|
||
3215 06764 7751 M27, -27
|
||
3216 06765 0027 P27, 27
|
||
3217 06766 7271 RAROP1, RAROP
|
||
3218 06767 7251 RARAC1, RARAC
|
||
3219 06770 5713 FLAD3, TRPLAD
|
||
3220 06771 7000 NORF, FNORM
|
||
3221 /DIRECTORY FOR INTERPRETIVE INPUT
|
||
3222 06772 3347 ASKLS2, INTERM /CR, TERMINATOR
|
||
3223 06773 3347 INTERM /FF, TERMINATOR
|
||
3224 06774 3330 INBARR /BA, RESTART INPUT
|
||
3225 06775 3347 INTERM /COMMA, TERMINATOR
|
||
3226 06776 3347 INTERM /USER-SPECIFIED TERMINATOR
|
||
3227 06777 3345 INGT /LF, IGNORE
|
||
3228
|
||
3229 MULPLR=.
|
||
3230 07000 0000 FNORM, 0 /ROUTINE TO NORMALIZE FLAC
|
||
3231 07001 7340 CLL CLA CMA /INITIALIZE SIGN SWITCH
|
||
3232 07002 3004 DCA FNEGSW
|
||
3233 07003 1045 TAD FLAC1 /TEST FOR ZERO
|
||
3234 07004 7450 SNA
|
||
3235 07005 1046 TAD FLAC2
|
||
3236 07006 7450 SNA
|
||
3237 07007 1047 TAD FLAC3
|
||
3238 07010 7650 SNA CLA
|
||
3239 07011 5232 JMP NOREND /ZERO, NO NEED TO NORMALIZE
|
||
3240 07012 1045 TAD FLAC1
|
||
3241 07013 7710 SPA CLA
|
||
3242 07014 4450 NEGATE /SIGN IS NEGATIVE
|
||
3243 07015 3255 DCA NORC /SHIFT COUNTER
|
||
3244 07016 1045 NRLOOP, TAD FLAC1 /SHIFT NEEDED?
|
||
3245 07017 7104 CLL RAL
|
||
3246 07020 7710 SPA CLA
|
||
3247 07021 5225 JMP NMEXIT /NO, BIT 1=1
|
||
3248 07022 4237 JMS RALAC
|
||
3249 07023 2255 ISZ NORC /RECORD A SHIFT
|
||
3250 07024 5216 JMP NRLOOP
|
||
3251 07025 2004 NMEXIT, ISZ FNEGSW /RESTORE SIGN
|
||
3252 07026 4450 NEGATE
|
||
3253 07027 1255 TAD NORC /CORRECT EXPONENT
|
||
3254 07030 7041 CIA
|
||
3255 07031 1044 TAD FLAC0
|
||
3256 07032 3044 NOREND, DCA FLAC0
|
||
3257 07033 3047 DCA FLAC3 /NORMALIZED # IS 3 WORDS
|
||
3258 07034 5600 JMP I FNORM
|
||
3259 07035 6601 FLTPT, FPNT+1
|
||
3260 07036 6662 NEGOP1, NEGOP
|
||
3261 PROD1=.
|
||
3262 07037 0000 RALAC, 0 /ROUTINE TO ROTATE FLAC 1 TO LEFT
|
||
3263 07040 1047 TAD FLAC3
|
||
3264 07041 7104 CLL RAL
|
||
3265 07042 3047 DCA FLAC3
|
||
3266 07043 4245 JMS DRAL /CALL DOUBLE RAL
|
||
3267 07044 5637 JMP I RALAC
|
||
3268 07045 0000 DRAL, 0 /ROTATE FLAC 1 LEFT, DOUBLE PRECISION
|
||
3269 07046 1046 TAD FLAC2
|
||
3270 07047 7004 RAL
|
||
3271 07050 3046 DCA FLAC2
|
||
3272 07051 1045 TAD FLAC1
|
||
3273 07052 7004 RAL
|
||
3274 07053 3045 DCA FLAC1
|
||
3275 07054 5645 JMP I DRAL
|
||
3276 NORC=.
|
||
3277 /ROUTINE TO TEST SIGNS OF FLAC AND FLOP,
|
||
3278 /PLACE FLAC IN TEMP, FOR FLMUL AND FLDIV
|
||
3279 07055 0000 FIXSGN, 0
|
||
3280 07056 7340 CLL CLA CMA
|
||
3281 07057 3004 DCA FNEGSW
|
||
3282 07060 1045 TAD FLAC1 /TEST FLAC
|
||
3283 07061 7450 SNA
|
||
3284 07062 5635 JMP I FLTPT /ZERO, NO OPERATION NEEDED
|
||
3285 07063 7710 SPACLA, SPA CLA
|
||
3286 07064 4450 NEGATE /TAKE ABS VAL OF FLAC
|
||
3287 07065 1045 TAD FLAC1 /TRANSFER TO TEMP
|
||
3288 07066 3162 DCA TEMP1
|
||
3289 07067 1046 TAD FLAC2
|
||
3290 07070 3163 DCA TEMP2
|
||
3291 07071 1041 TAD FLOP1
|
||
3292 07072 7710 SGNSWT, SPA CLA /SPA CLA FOR *, SMA CLA FOR /
|
||
3293 07073 4636 JMS I NEGOP1 /TAKE ABS VAL OF FLOP
|
||
3294 07074 1004 TAD FNEGSW
|
||
3295 07075 3157 DCA T2 /STORE SIGN OF RESULT
|
||
3296 07076 5655 JMP I FIXSGN
|
||
3297
|
||
3298 07077 1263 FLMUL, TAD SPACLA /OP 3: MULTIPLY BY OPERAND
|
||
3299 07100 3272 DCA SGNSWT /WANT POSITIVE OPERAND HERE
|
||
3300 07101 4255 JMS FIXSGN
|
||
3301 07102 1042 TAD FLOP2
|
||
3302 07103 4333 JMS SDMULT /MULTIPLY (TEMP1 TEMP2) BY FLOP2
|
||
3303 07104 7301 CLA CLL IAC /IGNORE LOW ORDER RESULT
|
||
3304 07105 1044 TAD FLAC0 /ADD EXPONENTS
|
||
3305 07106 1040 TAD FLOP0
|
||
3306 07107 3044 DCA FLAC0
|
||
3307 07110 1272 TAD PROD2 /SAVE PARTIAL RESULTS
|
||
3308 07111 3047 DCA FLAC3
|
||
3309 07112 1237 TAD PROD1
|
||
3310 07113 3046 DCA FLAC2
|
||
3311 07114 1041 TAD FLOP1
|
||
3312 07115 4333 JMS SDMULT /MULTIPLY (TEMP1 TEMP2) BY FLOP1
|
||
3313 07116 1047 TAD FLAC3
|
||
3314 07117 3047 DCA FLAC3 /COMBINE RESULTS OF MULTIPLICATIONS
|
||
3315 07120 7004 RAL
|
||
3316 07121 1272 TAD PROD2
|
||
3317 07122 1046 TAD FLAC2
|
||
3318 07123 3046 DCA FLAC2
|
||
3319 07124 7004 RAL
|
||
3320 07125 1237 TAD PROD1
|
||
3321 07126 3045 DCA FLAC1
|
||
3322 07127 4200 JMS FNORM /NORMALIZE RESULTS
|
||
3323 07130 2157 ISZ T2 /CHECK SIGN OF RESULT
|
||
3324 07131 4450 NEGATE
|
||
3325 07132 5635 JMP I FLTPT
|
||
3326
|
||
3327 07133 0000 SDMULT, 0 /UNSIGNED MULTIPLY ROUTINE
|
||
3328 07134 3200 DCA MULPLR /24 BY 12 BITS
|
||
3329 07135 3237 DCA PROD1
|
||
3330 07136 3272 DCA PROD2
|
||
3331 07137 1370 TAD M14
|
||
3332 07140 3255 DCA FIXSGN /SET TO COUNT 12 MULTIPLICATIONS
|
||
3333 07141 7100 CLL
|
||
3334 07142 1200 SDLOOP, TAD MULPLR /NEW MULTIPLIER BIT INTO LINK
|
||
3335 07143 7010 RAR
|
||
3336 07144 3200 DCA MULPLR /MULPLR ALSO ACCUMULATES LOW-ORDER
|
||
3337 07145 7420 SNL /RESULTS
|
||
3338 07146 5355 JMP SDSHIFT
|
||
3339 07147 7100 CLL /ADD MULTIPLIER IF BIT=1
|
||
3340 07150 1163 TAD TEMP2
|
||
3341 07151 1272 TAD PROD2
|
||
3342 07152 3272 DCA PROD2
|
||
3343 07153 7004 RAL
|
||
3344 07154 1162 TAD TEMP1
|
||
3345 07155 1237 SDSHIFT,TAD PROD1 /SHIFT PRODUCT ONE TO RIGHT
|
||
3346 07156 7010 RAR
|
||
3347 07157 3237 DCA PROD1
|
||
3348 07160 1272 TAD PROD2
|
||
3349 07161 7010 RAR
|
||
3350 07162 3272 DCA PROD2
|
||
3351 07163 2255 ISZ FIXSGN
|
||
3352 07164 5342 JMP SDLOOP
|
||
3353 07165 1200 TAD MULPLR /DONE, EXIT WITH LOW ORDER IN AC
|
||
3354 07166 7010 RAR
|
||
3355 07167 5733 JMP I SDMULT
|
||
3356 PROD2=SGNSWT
|
||
3357 07170 7764 M14, -14
|
||
3358
|
||
3359 07171 1041 FLDIV, TAD FLOP1 /OP 4: DIVIDE BY OPERAND
|
||
3360 07172 7650 SNA CLA
|
||
3361 07173 4526 ERROR /TRIED TO DIVIDE BY 0
|
||
3362 07174 1062 TAD P7700 /=SMA CLA
|
||
3363 07175 3272 DCA SGNSWT
|
||
3364 07176 4255 JMS FIXSGN
|
||
3365 07177 1040 TAD FLOP0 /SUBTRACT EXPONENTS
|
||
3366 07200 7041 CIA
|
||
3367 07201 1044 TAD FLAC0
|
||
3368 07202 7001 IAC
|
||
3369 07203 3044 DCA FLAC0
|
||
3370 07204 3045 DCA FLAC1 /ZERO FLAC FOR QUOTIENT
|
||
3371 07205 3046 DCA FLAC2
|
||
3372 07206 1314 TAD M30 /SET COUNTER
|
||
3373 07207 3271 DCA DIVCNT
|
||
3374 07210 5226 JMP DVLOOP
|
||
3375 07211 7420 DVSETQ, SNL /LINK IS QUOTIENT BIT
|
||
3376 07212 5216 JMP ZERQUO
|
||
3377 07213 3162 DCA TEMP1
|
||
3378 07214 1164 TAD TEMP3 /RESTORE LOW ORDER RESULT
|
||
3379 07215 3163 DCA TEMP2
|
||
3380 07216 7200 ZERQUO, CLA /SHIFT RESULT BIT INTO QUOTIENT
|
||
3381 07217 4647 JMS I DRALP /ROTATE LEFT DOUBLE PRECISION
|
||
3382 07220 1163 TAD TEMP2 /SHIFT DIVIDEND
|
||
3383 07221 7004 RAL
|
||
3384 07222 3163 DCA TEMP2
|
||
3385 07223 1162 TAD TEMP1
|
||
3386 07224 7004 RAL
|
||
3387 07225 3162 DCA TEMP1
|
||
3388 07226 7100 DVLOOP, CLL
|
||
3389 07227 1042 TAD FLOP2 /SUBTRACT DIVISOR FROM DIVIDEND
|
||
3390 07230 1163 TAD TEMP2
|
||
3391 07231 3164 DCA TEMP3
|
||
3392 07232 7004 RAL
|
||
3393 07233 1041 TAD FLOP1
|
||
3394 07234 1162 TAD TEMP1
|
||
3395 07235 2271 ISZ DIVCNT
|
||
3396 07236 5211 JMP DVSETQ
|
||
3397 07237 7210 CLA RAR /DONE, USE RESULT OF LAST SUBTRACTION
|
||
3398 07240 3047 DCA FLAC3 /AS EXTRA PRECISION
|
||
3399 07241 4650 JMS I NOR2
|
||
3400 07242 2157 ISZ T2
|
||
3401 07243 5646 JMP I FLOT1 /RESTORE SIGN
|
||
3402 07244 4450 NEGATE
|
||
3403 07245 5646 JMP I FLOT1
|
||
3404 07246 6601 FLOT1, FPNT+1
|
||
3405 07247 7045 DRALP, DRAL
|
||
3406 07250 7000 NOR2, FNORM
|
||
3407
|
||
3408 07251 0000 RARAC, 0 /ROUTINE TO ROTATE FLAC 1 RIGHT
|
||
3409 07252 7300 CLA CLL
|
||
3410 07253 1045 TAD FLAC1
|
||
3411 07254 7510 SPA
|
||
3412 07255 7020 CML /PROPOGATE SIGN BIT
|
||
3413 07256 7010 RAR /SHIFT
|
||
3414 07257 3045 DCA FLAC1
|
||
3415 07260 1046 TAD FLAC2
|
||
3416 07261 7010 RAR
|
||
3417 07262 3046 DCA FLAC2
|
||
3418 07263 1047 TAD FLAC3
|
||
3419 07264 7010 RAR
|
||
3420 07265 3047 DCA FLAC3
|
||
3421 07266 2044 ISZ FLAC0 /ADJUST EXPONENT
|
||
3422 07267 5651 JMP I RARAC
|
||
3423 07270 5651 JMP I RARAC
|
||
3424 DIVCNT=.
|
||
3425 07271 0000 RAROP, 0 /ROUTINE TO SHIFT FLOP 1 RIGHT
|
||
3426 07272 7300 CLA CLL
|
||
3427 07273 1041 TAD FLOP1
|
||
3428 07274 7510 SPA
|
||
3429 07275 7020 CML
|
||
3430 07276 7010 RAR
|
||
3431 07277 3041 DCA FLOP1
|
||
3432 07300 1042 TAD FLOP2
|
||
3433 07301 7010 RAR
|
||
3434 07302 3042 DCA FLOP2
|
||
3435 07303 1043 TAD FLOP3
|
||
3436 07304 7010 RAR
|
||
3437 07305 3043 DCA FLOP3
|
||
3438 07306 2040 ISZ FLOP0
|
||
3439 07307 5671 JMP I RAROP
|
||
3440 07310 5671 JMP I RAROP
|
||
3441 /ROUTINE TO FIX FLAC - "FIX"
|
||
3442 /REMOVE FRACTIONAL PART BUT LEAVE FLOATING
|
||
3443 /FIXED NUMBER IN AC ON EXIT
|
||
3444 07311 0000 XFIX, 0
|
||
3445 07312 7300 CLA CLL
|
||
3446 07313 1044 TAD FLAC /TEST EXPONENT
|
||
3447 07314 7750 M30, SPA SNA CLA /IF -1<#<1, CLEAR ENTIRELY
|
||
3448 07315 3044 DCA FLAC /EXCEPT FOR SIGN BIT
|
||
3449 07316 1044 TAD FLAC
|
||
3450 07317 1331 TAD FIXC
|
||
3451 07320 3271 DCA DIVCNT
|
||
3452 07321 7430 SZL
|
||
3453 07322 5711 JMP I XFIX /TOO BIG TO FIX
|
||
3454 07323 4251 JMS RARAC /FIX BY ROTATING FRACTIONAL BITS
|
||
3455 07324 2271 ISZ DIVCNT /OUT OF FLAC
|
||
3456 07325 5323 JMP .-2
|
||
3457 07326 3047 DCA FLAC+3 /CLEAR FRACTIONAL PART
|
||
3458 07327 1046 TAD FLAC+2
|
||
3459 07330 5711 JMP I XFIX
|
||
3460 07331 7751 FIXC, -27
|
||
3461 /ROUTINE TO FLOAT C(AC) AS FLOATING PT. INTEGER
|
||
3462 /- "FLOAT"
|
||
3463 07332 0000 XFLOAT, 0
|
||
3464 07333 3045 DCA FLAC1 /SAVE NUMBER
|
||
3465 07334 3046 DCA FLAC2
|
||
3466 07335 3047 DCA FLAC3
|
||
3467 07336 1005 TAD P13 /INTEGER EXPONENT
|
||
3468 07337 3044 DCA FLAC0
|
||
3469 07340 4251 JMS RARAC /IN CASE NUMBER WAS 4000
|
||
3470 07341 4650 JMS I NOR2 /NORMALIZE
|
||
3471 07342 5732 JMP I XFLOAT
|
||
3472
|
||
3473 07343 7037 RFLAC, RALAC
|
||
3474 07344 5713 TFLAD, TRPLAD
|
||
3475 07345 7774 M4, -4
|
||
3476 07346 4421 RANDOM, 4421 /CURRENT RANDOM NUMBER
|
||
3477 07347 3040 3040
|
||
3478 07350 0001 0001
|
||
3479 /STATISTICAL RANDOM NUMBER GENERATOR
|
||
3480 /BASED ON DECUS 5-25, POWER RESIDUE METHOD
|
||
3481 /NEW R=R*(2^17+3) MOD 36 BITS
|
||
3482 07351 4407 FRAN, FENT
|
||
3483 07352 7346 FGT RANDOM /R=OLD RANDOM NUMBER
|
||
3484 07353 0000 FEXT /ALREADY SHIFTED LEFT 12 BITS
|
||
3485 07354 4504 PUSHF
|
||
3486 07355 7346 RANDOM
|
||
3487 07356 4505 POPF
|
||
3488 07357 0041 FLOP1
|
||
3489 07360 1345 TAD M4 /SHIFT 4 MORE TO GET R*2^16
|
||
3490 07361 3156 DCA T1
|
||
3491 07362 4743 JMS I RFLAC
|
||
3492 07363 2156 ISZ T1
|
||
3493 07364 5362 JMP .-2
|
||
3494 07365 4744 JMS I TFLAD /+R = R*(2^16+1)
|
||
3495 07366 4743 JMS I RFLAC /*2 = R*(2^17+2)
|
||
3496 07367 4744 JMS I TFLAD /+R = R*(2^17+3)
|
||
3497 07370 4504 PUSHF
|
||
3498 07371 0045 FLAC1
|
||
3499 07372 4505 POPF
|
||
3500 07373 7346 RANDOM /SAVE NEW RANDOM NUMBER
|
||
3501 07374 3047 DCA FLAC3
|
||
3502 07375 3044 DCA FLAC0 /MAKE IT A 2-WORD FRACTION
|
||
3503 07376 1045 TAD FLAC1 /CHECK SIGN
|
||
3504 07377 7700 SMA CLA
|
||
3505 07400 5500 RETURN /POSITIVE
|
||
3506 07401 2046 ISZ FLAC2 /NEGATIVE, TAKE 1S COMPLEMENT
|
||
3507 07402 7410 SKP
|
||
3508 07403 2045 ISZ FLAC1
|
||
3509 07404 4450 NEGATE
|
||
3510 07405 5500 RETURN
|
||
3511
|
||
3512 07406 1407 FLPOW, TAD I 7 /OP 0: RAISE FLAC TO POWER
|
||
3513 07407 4503 PUSHA /SAVE FLOATING POINTER
|
||
3514 07410 4504 PUSHF /SAVE FLAC
|
||
3515 07411 0044 FLAC
|
||
3516 07412 4505 POPF
|
||
3517 07413 7545 FLTEMP
|
||
3518 07414 4504 PUSHF /GET FLOP
|
||
3519 07415 0040 FLOP
|
||
3520 07416 4505 POPF
|
||
3521 07417 0044 FLAC
|
||
3522 07420 4452 FIX /FIX OPERAND
|
||
3523 07421 7710 SPA CLA
|
||
3524 07422 7001 IAC
|
||
3525 07423 1045 TAD FLAC1
|
||
3526 07424 7640 SZA CLA
|
||
3527 07425 4526 ERROR /RAISING TO TOO HIGH A POWER
|
||
3528 07426 1046 TAD FLAC2
|
||
3529 07427 3350 DCA XFL
|
||
3530 07430 4407 FENT /PUT 1. IN FLAC
|
||
3531 07431 5661 FGT I ONEP
|
||
3532 07432 0000 FEXT
|
||
3533 07433 1350 TAD XFL
|
||
3534 07434 7450 SNA
|
||
3535 07435 5255 JMP FLXEND /X^0=1, DO NOT MULTIPLY
|
||
3536 07436 7500 SMA
|
||
3537 07437 5246 JMP RAISTP /RAISE TO + POWER
|
||
3538 07440 4407 FENT /RAISE TO - POWER
|
||
3539 07441 7545 FDV FLTEMP
|
||
3540 07442 7545 FPT FLTEMP
|
||
3541 07443 5661 FGT I ONEP
|
||
3542 07444 0000 FEXT
|
||
3543 07445 5250 JMP .+3
|
||
3544 07446 7041 RAISTP, CIA
|
||
3545 07447 3350 DCA XFL /SET COUNTER
|
||
3546 07450 4407 FENT /DO MULTIPLICATIONS
|
||
3547 07451 7545 FMY FLTEMP
|
||
3548 07452 0000 FEXT
|
||
3549 07453 2350 ISZ XFL
|
||
3550 07454 5250 JMP .-4
|
||
3551 07455 1413 FLXEND, POPA /RESTORE FLOATING POINTER
|
||
3552 07456 3407 DCA I 7
|
||
3553 07457 5660 JMP I .+1
|
||
3554 07460 6601 FPNT+1
|
||
3555 07461 1573 ONEP, FLTONE
|
||
3556 /FLOATING SQUARE ROOT FUNCTION
|
||
3557 07462 1045 FSQT, TAD FLAC1 /TEST SIGN
|
||
3558 07463 7510 SPA
|
||
3559 07464 4526 ERROR /SQUARE ROOT OF NEG NUMBER
|
||
3560 07465 7650 SNA CLA
|
||
3561 07466 5500 RETURN /ZERO, RESULT IS ZERO
|
||
3562 07467 1044 TAD FLAC0 /CONSTRUCT INITIAL APPROXIMATION
|
||
3563 07470 7510 SPA /BY HALVING EXPONENT
|
||
3564 07471 7020 CML
|
||
3565 07472 7010 RAR
|
||
3566 07473 3044 DCA FLAC0
|
||
3567 07474 1334 TAD SQCON
|
||
3568 07475 3045 DCA FLAC1
|
||
3569 07476 4407 SQLOOP, FENT /MAKE NEW APPROXIMATION
|
||
3570 07477 7545 FPT FLTEMP /NEW X=(N/X+X)/2
|
||
3571 07500 5560 FGT I FLARGP /ORIGINAL ARG
|
||
3572 07501 7545 FDV FLTEMP
|
||
3573 07502 7545 FAD FLTEMP
|
||
3574 07503 0000 FEXT
|
||
3575 07504 7040 CMA
|
||
3576 07505 1044 TAD FLAC0
|
||
3577 07506 3044 DCA FLAC0
|
||
3578 07507 1044 TAD FLAC0 /COMPARE OLD AND NEW APPROXIMATIONS
|
||
3579 07510 7041 CIA
|
||
3580 07511 1345 TAD FLTEMP
|
||
3581 07512 7640 SZA CLA
|
||
3582 07513 5276 JMP SQLOOP /EXPONENTS NOT EQUAL
|
||
3583 07514 1045 TAD FLAC1
|
||
3584 07515 7041 CIA
|
||
3585 07516 1346 TAD FLTEMP+1
|
||
3586 07517 7640 SZA CLA
|
||
3587 07520 5276 JMP SQLOOP /HIGH ORDER NOT EQUAL
|
||
3588 07521 1046 TAD FLAC2
|
||
3589 07522 7041 CIA
|
||
3590 07523 1347 TAD FLTEMP+2
|
||
3591 07524 7450 SNA /COMPARE LOW ORDERS TO
|
||
3592 07525 5500 RETURN /WITHIN PLUS OR MINUS ONE BIT
|
||
3593 07526 7500 SMA
|
||
3594 07527 7041 CIA
|
||
3595 07530 7001 IAC
|
||
3596 07531 7650 SNA CLA
|
||
3597 07532 5500 RETURN
|
||
3598 07533 5276 JMP SQLOOP
|
||
3599 07534 3015 SQCON, 3015
|
||
3600 /FUNCTION TO EVALUATE SIGN PART OF FLAC
|
||
3601 /RESULTS: -1 FOR NEGATIVE, 0 FOR ZERO, +1 FOR POSITIVE
|
||
3602 07535 1045 FSGN, TAD FLAC1
|
||
3603 07536 7450 SNA
|
||
3604 07537 5343 JMP .+4 /ZERO, SET RESULT TO 0
|
||
3605 07540 7710 SPA CLA
|
||
3606 07541 1034 TAD M2 /NEGATIVE (-1)
|
||
3607 07542 7001 IAC /POSITIVE (+1)
|
||
3608 07543 4430 FLOAT /FLOAT C(AC) = -1,0,1
|
||
3609 07544 5500 RETURN
|
||
3610 DIGBUF=. /OUTPUT DIGIT BUFFER (8 WORDS)
|
||
3611 07545 0000 FLTEMP, 0 /TEMPORARY REGISTERS
|
||
3612 07546 0000 0
|
||
3613 07547 0000 0
|
||
3614 ASKBUF=. /"ASK" INPUT BUFFER (TO END OF PAGE)
|
||
3615 ASKBND=7612 /END+12 OF "ASK" INPUT BUFFER
|
||
3616 07550 0000 XFL, 0
|
||
3617 $
|