Commit | Line | Data |
---|---|---|
7af5ad59 PH |
1 | /IOH SUBROUTINE OS8 FORTRAN II LIBRARY |
2 | / | |
3 | / | |
4 | / | |
5 | / | |
6 | / | |
7 | / | |
8 | / | |
9 | / | |
10 | / | |
11 | /COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION | |
12 | / | |
13 | / | |
14 | / | |
15 | / | |
16 | / | |
17 | / | |
18 | / | |
19 | / | |
20 | / | |
21 | / | |
22 | /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE | |
23 | /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT | |
24 | /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY | |
25 | /FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL. | |
26 | / | |
27 | /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER | |
28 | /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED | |
29 | /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH | |
30 | /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL. | |
31 | / | |
32 | /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE | |
33 | /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY | |
34 | /DIGITAL. | |
35 | / | |
36 | / | |
37 | / | |
38 | / | |
39 | / | |
40 | / | |
41 | / | |
42 | / | |
43 | / | |
44 | / | |
45 | \f/ VERSION 10A | |
46 | / APRIL 28,1977 | |
47 | / INPUT OUTPUT CONVERSION SUBROUTINE | |
48 | / FOR 8K ALICS-FORTRAN SYSTEM | |
49 | / VERSION NUMBER IS AVAILABLE AT ENTRY POINTS | |
50 | / | |
51 | ABSYM SACH 23 /SAVE FPAC FOR MANIPULATION OF AC | |
52 | ABSYM SACM 24 | |
53 | ABSYM SACL 25 | |
54 | ABSYM N2 175 /LAST ACCUMULATED NUMBER | |
55 | ABSYM ARGUMT 176 | |
56 | DUMMY ARGUMT | |
57 | DUMMY FPNT | |
58 | ENTRY READ | |
59 | ENTRY WRITE | |
60 | ENTRY IOH | |
61 | / | |
62 | / THE FOLLOWING IS NECESSARY BECAUSE CERTAIN SUBROUTINES SKIP | |
63 | / | |
64 | OPDEF TADI 1400 | |
65 | OPDEF DCAI 3400 | |
66 | OPDEF ANDI 0400 | |
67 | OPDEF JMPI 5400 | |
68 | OPDEF JMSI 4400 | |
69 | OPDEF ISZI 2400 | |
70 | SKPDF JMSKP 4000 | |
71 | LAP | |
72 | ||
73 | / | |
74 | A2, BLOCK 14 | |
75 | / | |
76 | / IOH ERROR ROUTINES | |
77 | / | |
78 | ERRNO, BLOCK 1 | |
79 | ERR2, ISZ WHI /SEE IF THIS WAS I FORMAT OR THE EXPONENT | |
80 | ERR3, ISZ ERRNO /IN E FORMAT | |
81 | ISZ ERRNO | |
82 | SKP | |
83 | ERR1, ISZ DV /ERR1 IS ALWAYS FATAL | |
84 | CLA | |
85 | TAD DV | |
86 | SNA CLA /WAS THIS AN INPUT ERROR FROM THE TELETYPE? | |
87 | CLA CLL CML RAR /YES - NON-FATAL | |
88 | TAD (615 | |
89 | DCA IO | |
90 | TAD ERRNO /IOH ERROR NUMBER | |
91 | TAD (2461 /MAKE INTO BCD | |
92 | DCA SW /TO ERROR COMMENT | |
93 | CALL 1,ERROR | |
94 | ARG IO | |
95 | ||
96 | JMP RETRY /DO ENTIRE READ STATEMENT OVER | |
97 | DV, 0 /SAVE DEVICE CODE | |
98 | CS, A2 /INITIAL PUSH POINTER | |
99 | PARN, 0 | |
100 | NOP /CDF N | |
101 | TADI WRITE# | |
102 | INC WRITE# | |
103 | JMP I PARN | |
104 | CH, 0 | |
105 | TW, 12 | |
106 | READ, BLOCK 1 | |
107 | 10 /ENTRY POINT FOR READ | |
108 | RETRY, TAD READ /SNEAK IN | |
109 | DCA WRITE | |
110 | TAD READ# | |
111 | DCA WRITE# /SAVE SECOND RETURN WORD | |
112 | JMP ET | |
113 | CPAGE 4 | |
114 | IO, 0 | |
115 | SW, 0 /LEFT OR RIGHT HALF OF FORMAT | |
116 | WRITE, BLOCK 1 | |
117 | 10 /ENTRY POINT | |
118 | CLA IAC /INITIALIZE SWITCH | |
119 | ET, DCA IO | |
120 | DCA CH /CLEAR CHARACTER | |
121 | DCA ERRNO /ZERO ERROR NUMBER IN CASE ERROR RESTART | |
122 | TAD WRITE | |
123 | DCA PARN# | |
124 | JMS PARN | |
125 | DCA DEVNO1 | |
126 | JMS PARN | |
127 | DCA 7 | |
128 | DEVNO1, NOP /CDF N | |
129 | CLA CMA | |
130 | TADI 7 /PICK UP DEVICE NUMBER | |
131 | CLL RTR /ROTATE IT INTO BITS 0-3 | |
132 | RTR | |
133 | RAR | |
134 | DCA DV | |
135 | TAD CS /INITIALIZE PUSH STACK | |
136 | DCA PUSH /- | |
137 | JMS PARN | |
138 | DCA FPNT01 | |
139 | JMS PARN | |
140 | DCA FPNT | |
141 | CLA IAC /SET UP "SW" TO START FORMAT | |
142 | DCA SW /FROM SECOND CHARACTER (FIRST IS LPAREN) | |
143 | DCA BA /ZAP END-OF-LINE SWITCH | |
144 | TAD PENTER /FAKE RE-ENTRY TO SET UP FIRST LPAREN | |
145 | DCA GLST /ON PUSHDOWN STACK | |
146 | RETRN WRITE | |
147 | PENTER, FENTER | |
148 | ||
149 | FPNT, 0 | |
150 | GFRM, 0 | |
151 | TAD SW | |
152 | INC SW | |
153 | CLL RAR | |
154 | TAD FPNT /FORM ADDRESS IN AC AND LEFT/RIGHT | |
155 | DCA 7 /SWITCH IN LINK | |
156 | FPNT01, NOP /CDF N | |
157 | TADI 7 | |
158 | SZL /LEFT OR RIGHT? | |
159 | JMP HR | |
160 | RTR | |
161 | RTR | |
162 | RTR | |
163 | HR, AND (77 | |
164 | JMP I GFRM | |
165 | CPAGE 5 | |
166 | 0 /I1000 | |
167 | 0 /I100 | |
168 | 0 /I10 | |
169 | I1, 0 /I1 | |
170 | 4000 | |
171 | SV, BLOCK 3 /FLOATING POINT TEMPORARY | |
172 | CPAGE 3 | |
173 | TN, 2045 /10.0 | |
174 | 0 | |
175 | 0 | |
176 | \f PAGE /EXPERIMENTAL | |
177 | RETN, DCA SACH /SET SACH TO 0 | |
178 | RTUR, JMS GFRM /GET NEXT CHAR IN FORMAT | |
179 | CPAGE 24 | |
180 | JMS CHTYPE /CLASSIFY FORMAT CHARACTER | |
181 | DG /DIGIT EXIT | |
182 | -57; SL | |
183 | -56; PER | |
184 | -54; CM | |
185 | -51; RPAR | |
186 | -50; LP | |
187 | -47; QT | |
188 | -40; RTUR | |
189 | 0; SVCHR | |
190 | SVCHR, DCA CH | |
191 | JMS NU /GET THE ACCUMULATED NUMBER | |
192 | CMA /KRONK IT | |
193 | DCA N1 /AND SAVE COUNT FOR ALL CONVERSIONS | |
194 | TAD CH | |
195 | AND (7757 | |
196 | TAD (7770 /THIS TESTS IF CH IS AN ,X, OR ,H, | |
197 | SNA CLA | |
198 | CM, JMS PR /IT WAS , PROCESS IT | |
199 | JMP RETN /NOT X OR H, KILL NUMBER AND TRY AGAIN | |
200 | N1, 0 | |
201 | ||
202 | SL, JMS PR /GO PROCESS THE PREVIOUS ITEM (IF ANY) | |
203 | JMS EJ | |
204 | JMP RETN | |
205 | QT, JMS PR /PROCESS PREVIOUS ITEM, IF ANY | |
206 | QT1, JMS GFRM | |
207 | TAD (-47 | |
208 | SNA /ANOTHER QUOTE? | |
209 | JMP RETN | |
210 | TAD (47 | |
211 | JMS PRINT /PRINT CHAR | |
212 | JMP QT1 | |
213 | DG, JMS DGT /ACCUMULATE DIGIT INTO SACH | |
214 | JMP RTUR /TRY ANOTHER CHARACTER | |
215 | LP, ISZ PUSH /LEFT PAREN | |
216 | CLA CMA /COUNT NESTING DEPTH, NEGATIVE | |
217 | TAD NPAR | |
218 | DCA NPAR | |
219 | TAD SW /PICK UP THE FORMAT POINTER | |
220 | DCA I PUSH /CRAM IT INTO THE LIST | |
221 | ISZ PUSH /KICK AGAIN | |
222 | JMS NU /THERE MAY BE AN ACCUMULATED NUMBER | |
223 | CIA /SAVE NUMBER | |
224 | DCA I PUSH /* | |
225 | CLA CLL CML RTL /HERE WE SEE IF THIS IS A POSSIBLE | |
226 | TAD NPAR /RESTART POINT | |
227 | SPA CLA /IF FIRST SAVE SW IN S1 | |
228 | JMP RETN /NOPE- FORGET IT | |
229 | TAD SW /YES--FIRST CRAM FORMAT--- | |
230 | DCA S1 /---INTO SAVE1 | |
231 | TAD I PUSH /AND THAT STUFF IN THE LIST--- | |
232 | DCA S2 /---GOES INTO SAVE 2 | |
233 | JMP RETN /READY FOR ANYTHING, HERE WE GO | |
234 | PUSH, 0 /PARENTHESIS PUSHDOWN LIST POINTER | |
235 | ||
236 | RPAR, JMS PR /PROCESS PREVIOUS ITEM, IF ANY | |
237 | ISZ I PUSH | |
238 | JMP TR | |
239 | CLA CLL CMA RAL /-2 | |
240 | TAD PUSH /DELETE THIS ITEM FORM THE LIST | |
241 | DCA PUSH /PUSH = PUSH-2 | |
242 | ISZ NPAR /NPAR = NPAR +1 ]-1[ SINCE MINUS COUNT | |
243 | JMP RETN | |
244 | JMS WH /THIS PAREN WAS THE BALANCING PAREN | |
245 | TAD S1 /GET THE FORMAT POINTER OF THE-- | |
246 | DCA SW /RESTART POINT AND CRAM IT | |
247 | TAD S2 /GET SWITCH AND THE COUNT | |
248 | CIA | |
249 | FENTER, DCA SACH | |
250 | CLA CMA | |
251 | TAD SW /TEST TO SEE IF SW IS ORIGINAL POINTER | |
252 | SNA CLA | |
253 | JMP L2 /YES - FAKE A RESTART | |
254 | ISZ PUSH /NO - PUSH ORIGINAL POINTER | |
255 | CLA IAC /SINCE WE ARE RETURNING TO DEPTH 2 | |
256 | DCA I PUSH | |
257 | ISZ PUSH | |
258 | CLA CMA /SET COUNT = 1, SWITCH = 1 | |
259 | DCA I PUSH | |
260 | CMA | |
261 | L2, DCA NPAR /PARNRN = -1 | |
262 | JMP LP | |
263 | ||
264 | TR, CLA CMA /GET OUT THE FORMAT POINTER-- | |
265 | TAD PUSH /* | |
266 | DCA N3 | |
267 | TAD I N3 | |
268 | DCA SW /HAA-- IT IS NOW RESTORED | |
269 | JMP RETN /AWAY WE GO | |
270 | N3, 0 /W FOR E AND F CONVER | |
271 | PER, JMS NU /GOT A PERIOD, MUST BE OR F TYPE | |
272 | DCA N3 | |
273 | JMP RETN | |
274 | S1, 0 | |
275 | S2, 0 /SAVE THE COUNT AND SWITCH | |
276 | NPAR, 0 | |
277 | \f PAGE /EXPERIMENTAL | |
278 | ||
279 | EX, JMS GLST /THIS IS E FORMAT CONVERSION | |
280 | EE, JMS NR /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1] | |
281 | TAD C | |
282 | DCA GLST /STORE C AWAY IN A SAFE PLACE | |
283 | DCA C | |
284 | CLA CMA | |
285 | DCA EFLG /SET "E FORMAT FAKEOUT" FLAG | |
286 | TAD (-5 | |
287 | JMP FFAKE /FAKE OUT "F" FORMAT TO PRINT DIGITS | |
288 | PRNTE, TAD (5 /PUT OUT THE E | |
289 | JMS PRINT | |
290 | ||
291 | ||
292 | / NOW PRINT 'C' DIGITS UNDER I3 FORMAT | |
293 | TAD GLST | |
294 | SPA SNA CLA | |
295 | CLA CLL CMA RAL | |
296 | TAD (55 | |
297 | JMS PRINT /PRINT A MINUS OR PLUS | |
298 | TAD GLST | |
299 | SPA | |
300 | CIA | |
301 | CALL 1,DIV | |
302 | ARG TW | |
303 | TAD (60 | |
304 | JMS PRINT /PRINT | |
305 | CPAGE 4 | |
306 | CALL 0,IREM /IREM NEEDS AN ARGUMENT TO IGNORE | |
307 | EFLG, 0 | |
308 | CRX, 0 | |
309 | TAD (60 | |
310 | JMS PRINT /PRINT SECOND DIGIT | |
311 | JMP EX /DONE, DO NEXT | |
312 | ||
313 | FX, CLA | |
314 | JMS GLST /THIS IS F FORMAT CONVERSION | |
315 | FF, JMS NR /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1] | |
316 | DCA EFLG | |
317 | TAD C /C CONTAINS NUMBER OF MULTS TO RANGE NUMBER | |
318 | SMA | |
319 | CLA CMA /0 MULTS NEEDED OR ALREADY THERE | |
320 | FFAKE, TAD N3 /NUM3 IS THE FIELD WIDTH | |
321 | CIA /MINUS SPACE FOR DADP+DP | |
322 | TAD N2 | |
323 | JMS SA /PUT OUT REQUIRED BLANKS + SIGN | |
324 | TAD C | |
325 | SMA | |
326 | JMP PRZRO /NO LEADING DIGIT - PRINT A ZERO FOR LOOKS | |
327 | CIA | |
328 | JMS DT | |
329 | PRDCPT, TAD (56 | |
330 | JMS PRINT | |
331 | TAD C /GET MULTIPLY COUNT | |
332 | SPA SNA | |
333 | JMP PAS2 | |
334 | CMA /THEY WERE MULTIPLIES, 0 TO N OF THEM | |
335 | DCA CRX | |
336 | TAD N2 /DIGITS AFTER DEC POINT, DADP | |
337 | CMA | |
338 | DCA NR | |
339 | JMP PASA /TEST FOR 0 MULTIPLIES | |
340 | RETR, TAD (60 /PUT OUT A ZERO | |
341 | JMS PRINT /ALL MULTIPLIES REPRESENTED | |
342 | PASA, ISZ CRX /NO, TRY RUN OFF FIELD | |
343 | SKP | |
344 | JMP PASS /YES | |
345 | ISZ NR /ALL WIDTH ACCOUNTED FOR% | |
346 | JMP RETR /NO, TRY NEXT POSITION | |
347 | ||
348 | ||
349 | PASS, TAD C /YES, GET MULT COUNT | |
350 | CIA /-MULT COUNT | |
351 | SKP | |
352 | PAS2, CLA | |
353 | TAD N2 /N2-MULT COUNT | |
354 | SMA SZA /IS MULT COUNT .GE. N2? | |
355 | JMS DT /NO - PRINT REMAINING DIGITS | |
356 | ISZ EFLG /WERE WE FAKED OUT BY "E" FORMAT? | |
357 | JMP FX /NO | |
358 | JMP PRNTE /YES - GO PRINT EXPONENT | |
359 | PRZRO, CLA | |
360 | TAD (60 | |
361 | JMS PRINT | |
362 | JMP PRDCPT /GO BACK TO PRINT THE DECIMAL POINT | |
363 | ||
364 | SA, 0 | |
365 | TAD SN | |
366 | SMA /THIS IS -(NUM OF BLANKS) | |
367 | JMP AS3 /POSITIVE, NUMBER TOO BIG FOR FIELD | |
368 | DCA CRX | |
369 | SKP CLA | |
370 | RETC, JMS PRINT /HERE WE PUT OUT THAT MANY BLANKS | |
371 | TAD (40 | |
372 | ISZ CRX | |
373 | JMP RETC /YES | |
374 | CLA | |
375 | TAD SN | |
376 | SNA CLA /IS SIGN MINUS? | |
377 | JMP I SA /EVIDENTLY NOT | |
378 | TAD (55 | |
379 | JMS PRINT /PUT OUT A MINUS SIGN | |
380 | JMP I SA | |
381 | ||
382 | \f PAGE /EXPERIMENTAL | |
383 | FN, TAD N3 /GET WIDTH, INPUT FOR E OR F FORMAT | |
384 | CMA /1'S COMPLEMENT | |
385 | DCA CR /TO COUNTER | |
386 | DCA D1 /0 TO D1 | |
387 | CALL 0,CLEAR | |
388 | CMA | |
389 | DCA D2 /-1 TO DECIMAL POINT SWITCH | |
390 | CMA /-0 TO SGN FLAG | |
391 | RRTSGN, DCA SN | |
392 | RRT, CLA | |
393 | ISZ CR /INDEX TO SEE IF WIDTH EXCEEDED | |
394 | SKP | |
395 | JMP FP /GET AN INPUT CHARACTER AND TEST IT | |
396 | JMS GCHR | |
397 | CPAGE 20 | |
398 | JMS CHTYPE /CLASSIFY INPUT CHAR | |
399 | FDIGIT /DIGIT | |
400 | -56; PUNT | |
401 | -40; RRT | |
402 | -53; RRT | |
403 | -55; RRTSGN | |
404 | -5; EPRO | |
405 | 0 | |
406 | PERR3, ERR3 | |
407 | FDIGIT, DCA IS | |
408 | CALL 1,FMP | |
409 | ARG TN | |
410 | CALL 1,STO /SAVE FLOATING POINT ACCUMULATOR | |
411 | ARG SV | |
412 | TAD IS | |
413 | CALL 0,FLOT /FLOAT NEW DIGIT | |
414 | CALL 1,FAD | |
415 | ARG SV | |
416 | INC D1 /COUNT OF DIGITS | |
417 | JMP RRT | |
418 | PUNT, ISZ D2 /TST DP SWITCH | |
419 | JMPI PERR3 /***** TWO DECIMAL POINTS ***** | |
420 | DCA D1 | |
421 | JMP RRT | |
422 | EPRO, CLA CMA /AN E | |
423 | FP, DCA IS /-1 TO IS IF E, 0 TO IS IF END OF FIELD | |
424 | ISZ D2 /TEST DP SWITCH | |
425 | JMP FA /ONE HAS OCCURRED | |
426 | TAD N2 /ONE HAS NOT OCCURRED, GET NDP | |
427 | SKP | |
428 | FA, TAD D1 /COUNT OF DIGITS AFTER EXPLICIT DP | |
429 | CMA /-COUNT | |
430 | JMS DH /DIVIDE FPAC BY TEN COUNT TIMES | |
431 | TAD ACH /IF ACH=0,DON'T CHK. SIGN | |
432 | SNA | |
433 | JMP ZR /ZERO-DON'T CHECK | |
434 | ISZ SN /TEST SIGN | |
435 | TAD (4000 /SET SIGN BIT | |
436 | DCA ACH | |
437 | ZR, ISZ IS /DID WE GET AN "E"? | |
438 | JMP VZA /NO - STORE RESULT AND GET OUT | |
439 | JMP VQ /YES - FAKE INTEGER ROUTINE TO ACCEPT EXPONENT | |
440 | D1, 0 | |
441 | D2, 0 | |
442 | IS, 0 | |
443 | CR, 0 | |
444 | ||
445 | PRO2, CMA /GOT EXPONENT - MAKE IT NEGATIVE | |
446 | ISZ SN /WHAT WAS ITS ORIGINAL SIGN? | |
447 | JMP VZB /NEGATIVE - DIVIDE BY 10^EXP | |
448 | DCA D1 /SAVE COUNT | |
449 | JMP VZD | |
450 | VZC, CALL 1,FMP | |
451 | ARG TN | |
452 | VZD, ISZ D1 /INDEX COUNT | |
453 | JMP VZC | |
454 | JMP VZA | |
455 | VZB, JMS DH | |
456 | VZA, CALL 1,ISTO /STORE IN PLACE | |
457 | ARG ARGUMT | |
458 | JMP FX | |
459 | \f PAGE /EXPERIMENTAL | |
460 | XX, JMS MR /TEST FOR MORE | |
461 | TAD IO /TEST FOR INPUT-OUTPUT | |
462 | SNA CLA | |
463 | JMP XX1 /INPUT, PSEUDO-JUMP | |
464 | TAD (40 /OUTPUT A BLANK | |
465 | JMS PRINT | |
466 | JMP XX /CYCLE | |
467 | XX1, JMS GCHR /IGNORE SPACES ON INPUT | |
468 | CLA | |
469 | JMP XX | |
470 | ||
471 | HH, JMS MR /THE H FIELD PROCESSOR | |
472 | JMS GFRM /SAME AS XXX, BUT PRINT NEXT | |
473 | JMS PRINT /----- FORMAT CHARACTER | |
474 | JMP HH /OUTPUT ONLY | |
475 | ||
476 | PRINT, 0 | |
477 | TAD (-40 | |
478 | SPA | |
479 | TAD (100 /CONVERT 6-BIT TO 8-BIT | |
480 | TAD (240 | |
481 | TAD DV /ADD ON DEVICE NUMBER IN BITS 0-3 | |
482 | CALL 0,GENIO | |
483 | JMP I PRINT | |
484 | ||
485 | WH, 0 | |
486 | JMS EJ /END THE RECORD | |
487 | TAD ARGUMT# | |
488 | SNA CLA /TEST PARAMETER FOR 0 | |
489 | JMS GLST /RETURN TO MAIN PROGRAM ON 0 PAR | |
490 | JMP I WH /MORE AGRUMENTS RETURN | |
491 | ||
492 | EJ, 0 /ROUTINE TO END RECORD | |
493 | TAD IO | |
494 | SZA CLA /INPUT OR OUTPUT? | |
495 | JMP E1 /OUTPUT | |
496 | E2, CLA | |
497 | TAD BA | |
498 | SZA CLA | |
499 | JMP BG /CARRIAGE RETURN SEEN - GOODBYE | |
500 | JMS GCHR /GET A CHARACTER | |
501 | JMP E2 /KEEP LOOKING FOR CR | |
502 | BG, DCA BA | |
503 | JMP I EJ | |
504 | E1, TAD (7715 /7715 TRANSLATES TO 215 | |
505 | JMS PRINT | |
506 | TAD (7712 | |
507 | JMS PRINT /PRINT CR-LF | |
508 | JMP I EJ | |
509 | ||
510 | BA, 0 /THIS IS THE END OF LINE SWITCH | |
511 | BH, ISZ BA /ENTRY TO LOOK FOR AN END OF LINE | |
512 | BL, TAD (40 | |
513 | AND (77 /KEEP THIS - BL IS REFERENCED BY GCHR | |
514 | JMP I GCHR | |
515 | ||
516 | GCHR, 0 /GET AN INPUT STRING CHARACTER | |
517 | JD, CLA | |
518 | TAD BA /GET EOR SWITCH | |
519 | SZA CLA | |
520 | JMP BL /IS EOR, RETURN BLANK | |
521 | CLA CLL CML RTR /****** IF # OF DEVICES IS CHANGED, | |
522 | TAD DV /THIS SHOULD BE CHANGED TOO ***** | |
523 | CALL 0,GENIO /CALL GENIO WITH OFFSET DEVICE NUMBER | |
524 | AND (177 /STRIP PARITY | |
525 | TAD (7763 | |
526 | SNA /CARRIAGE RETURN? | |
527 | JMP BH | |
528 | TAD (7655 | |
529 | CLL | |
530 | TAD (100 /IS CHAR IN RANGE 237<CHAR<340? | |
531 | SNL | |
532 | JMP JD /NO - IGNORE | |
533 | JMP BL /CONVERT TO SIXBIT AND RETURN | |
534 | \f PAGE /EXPERIMENTAL | |
535 | / GET F.P. NUMBER INTO THE RANGE .1 .LE. N .L. 1.0 | |
536 | NR, 0 | |
537 | JMSKP BB /CHECK DIRECTION OF I/O | |
538 | JMP FN /INPUT | |
539 | CALL 1,IFAD /OUTPUT - LOAD NUMBER INTO FLOATING AC | |
540 | ARG ARGUMT | |
541 | DCA SN /CLEAR THESE LOCS | |
542 | DCA C | |
543 | TAD ACH | |
544 | SNA | |
545 | JMP NREX /NUMBER IS ZERO | |
546 | SMA /IS IT A MINUS F P NUMBER | |
547 | JMP RETM | |
548 | TAD (4000 /YES-- MAKE IT POSITIVE | |
549 | ISZ SN /SET SIGN | |
550 | DCA ACH | |
551 | RETM, CLA /MULTIPLY BY 10 UNTIL NR .GT. (1.0) | |
552 | TAD ACH | |
553 | TAD (5764 | |
554 | SMA CLA | |
555 | JMP TB /GOT IT IT IS .GE.1 | |
556 | CALL 1,FMP | |
557 | ARG TN | |
558 | ISZ C /AND COUNT | |
559 | JMP RETM /GO TRY TO DO IT AGAIN | |
560 | TB, JMS SE /NOTE SE ' XR-1 | |
561 | CALL 1,STO | |
562 | ARG SV | |
563 | TAD (2004 | |
564 | DCA ACH /200400000000=.50000 IN AC | |
565 | TAD CH /TEST FORMAT | |
566 | TAD (7772 | |
567 | SNA CLA /IS IT E FORMAT? | |
568 | TAD C /NO - COUNT # OF MULTS NEEDED | |
569 | CIA | |
570 | TAD N2 /< DADP | |
571 | SMA | |
572 | CMA /NUMBER OF THIMES TO DIVIDE .5 BY 10 TO RND | |
573 | JMS DH /DO THE DIVIDES | |
574 | CALL 1,FAD | |
575 | ARG SV | |
576 | JMS SE /REDUCE TO NORMAL RANGE AGAIN | |
577 | ||
578 | ||
579 | GD, TAD ACH | |
580 | RAL | |
581 | SPA CLA | |
582 | JMP ZP /NUMBER IS ? 1/2 | |
583 | TAD ACH | |
584 | CLL RAR /WE ARE GETTING EXP TO 200 | |
585 | DCA ACH | |
586 | TAD ACM | |
587 | RAR | |
588 | DCA ACM | |
589 | TAD ACL | |
590 | RAR | |
591 | DCA ACL | |
592 | TAD ACH | |
593 | AND (7774 | |
594 | TAD ACH | |
595 | TAD (10 | |
596 | DCA ACH | |
597 | JMP GD | |
598 | ZP, TAD ACH | |
599 | AND (7 | |
600 | DCA ACH | |
601 | NREX, JMP I NR | |
602 | SN, 0 | |
603 | ||
604 | C, 0 /COUNTER FOR DEC. EXP. | |
605 | SE, 0 /DIVIDE BY 10 UNTIL N < 1.0 | |
606 | XR, TAD ACH /TEST NUMBER FOR .GE. 1 | |
607 | TAD (5764 | |
608 | SPA CLA | |
609 | JMP I SE /NUMBER IS IN RANGE, RETURN | |
610 | CLA CLL CMA RAL | |
611 | JMS DH | |
612 | CLA CMA /REDUCE COUNT | |
613 | TAD C | |
614 | DCA C | |
615 | JMP XR | |
616 | \f PAGE /EXPERIMENTAL | |
617 | GLST, 0 /GET NEXT ARGUMENT ROUTINE | |
618 | CALL 0,CLEAR /CLEAR FLOATING AC | |
619 | ISZ IOHCNT /ARE WE IN AN ARRAY I/O LOOP? | |
620 | JMP ARMORE /YES - GET NEXT ELEMENT | |
621 | INC IOH# | |
622 | RETRN IOH /RETURN TO USERS PROGRAM FOR MORE DATA | |
623 | ARMORE, TAD ARGUMT# | |
624 | TAD IOHINC /BUMP ARGUMENT POINTER BY ELEMENT LENGTH | |
625 | JMP IOHBAK /RESUME I/O CONVERSIONS WITH UPDATED ARGUMT | |
626 | ||
627 | CPAGE 33 | |
628 | IOH, BLOCK 1 | |
629 | 10 | |
630 | SZA CLA /IS THIS A SCALAR OR AN ARRAY CALL? | |
631 | JMP IOHAR /AN ARRAY CALL | |
632 | CLA CMA | |
633 | IOGTAR, DCA IOHCNT /SET UP ARGUMENT COUNT FOR THIS CALL | |
634 | TAD IOH | |
635 | DCA IOH1 | |
636 | IOH1, NOP /SET DATA FIELD TO ARGUMENT LIST | |
637 | TADI IOH# | |
638 | DCA ARGUMT | |
639 | INC IOH# | |
640 | TADI IOH# | |
641 | IOHBAK, DCA ARGUMT# | |
642 | JMP I GLST /RETURN TO I/O CONVERSION | |
643 | IOHAR, INC IOH# | |
644 | CLA CLL CML RAR | |
645 | AND I IOH /GET TYPE OF ARRAY | |
646 | CLL RTL | |
647 | CML RAL /FORM A 1 OR A 3, DEPENDING ON ARRAY TYPE | |
648 | DCA IOHINC | |
649 | CLA CLL CMA RAR | |
650 | ANDI 7 /GET THE ELEMENT COUNT | |
651 | CIA | |
652 | INC IOH# | |
653 | JMP IOGTAR /SAVE IT AND GET ARRAY POINTER | |
654 | IOHINC, 0 | |
655 | IOHCNT, 0 | |
656 | ||
657 | CHTYPE, 0 /SUBROUTINE TO CLASSIFY CHARACTERS | |
658 | DCA CHCH | |
659 | TAD CHCH | |
660 | TAD (7706 | |
661 | CLL | |
662 | TAD (12 | |
663 | SZL /IS THE CHARACTER NUMERIC? | |
664 | JMP JMPOUT /YES - TAKE FIRST EXIT | |
665 | INC CHTYPE | |
666 | CHLOOP, CLA | |
667 | TAD I CHTYPE | |
668 | INC CHTYPE | |
669 | SNA /CHARACTER LIST EXHAUSTED? | |
670 | JMP JMPOTX /YES - TAKE LAST EXIT WITH CHAR IN AC | |
671 | TAD CHCH | |
672 | SNA CLA /MATCH? | |
673 | JMP JMPOUT /YES - TAKE EXIT WITH AC=0 | |
674 | INC CHTYPE | |
675 | JMP CHLOOP /NO MATCH - GO ON TO NEXT CHAR | |
676 | JMPOUT, DCA CHCH | |
677 | JMPOTX, TAD I CHTYPE | |
678 | DCA CHTYPE | |
679 | TAD CHCH | |
680 | JMP I CHTYPE | |
681 | CHCH, 0 | |
682 | ||
683 | DT, 0 | |
684 | CIA | |
685 | DCA CHCH /STORE COUNT | |
686 | RETT, JMS LS /LEFT SHIFT 1 | |
687 | TAD ACL /SAVE THE FPAC | |
688 | DCA SACL | |
689 | TAD ACM | |
690 | DCA SACM | |
691 | TAD ACH | |
692 | AND (17 | |
693 | DCA SACH | |
694 | TAD SACH | |
695 | DCA ACH /TRIM AC TO 28 BITS | |
696 | JMS LS /LEFT SHIFT 2 | |
697 | JMS LS | |
698 | TAD ACL /ADD THE DSAVE TO THE ACC | |
699 | TAD SACL | |
700 | DCA ACL | |
701 | RAL /* | |
702 | TAD ACM | |
703 | TAD SACM | |
704 | DCA ACM | |
705 | RAL /* | |
706 | TAD ACH | |
707 | TAD SACH | |
708 | DCA ACH | |
709 | TAD ACH | |
710 | CLL RAR /ROTATE 3 RIGHT | |
711 | RTR | |
712 | AND (17 | |
713 | TAD (60 /MAKE DIGIT | |
714 | JMS PRINT /DUMP IT AND SEE IF ANY MORE | |
715 | ISZ CHCH /LOOP ON COUNT | |
716 | JMP RETT /* | |
717 | JMP I DT | |
718 | ||
719 | LS, 0 /LEFT SHIFT THE FPAC 1 | |
720 | TAD ACL | |
721 | CLL RAL | |
722 | DCA ACL | |
723 | TAD ACM | |
724 | RAL | |
725 | DCA ACM | |
726 | TAD ACH | |
727 | RAL | |
728 | DCA ACH | |
729 | JMP I LS /DONE | |
730 | \f PAGE /EXPERIMENTAL | |
731 | PR, 0 | |
732 | TAD SACH /GET THE LAST NUMBER ACCUMULATED | |
733 | DCA N2 /SAVE IT | |
734 | PR2, TAD CH | |
735 | SNA | |
736 | JMP I PR /NOTHING TO DO | |
737 | CPAGE 22 | |
738 | JMS CHTYPE /CLASSIFY CH | |
739 | ERR1 /DIGIT IS ILLEGAL | |
740 | -30;XX | |
741 | -11;II | |
742 | -10;HH | |
743 | -6;FF | |
744 | -5;EE | |
745 | -1;AA | |
746 | 0;ERR1 | |
747 | ||
748 | MR, 0 /MORE? | |
749 | ISZ N1 /SEE IF IT GOES TO ZERO | |
750 | JMP I MR | |
751 | DCA CH /NO MORE FIELDS, FIRST WIPE CHAR | |
752 | JMP I PR /GO BACK TO FORMAT SCANNER | |
753 | NU, 0 /ROUTINE TO FETCH THE ACCUM NUMB | |
754 | TAD SACH | |
755 | SNA /IF IT IS ZERO, SET IT TO 1 | |
756 | CLA IAC /IT IS AND WE DO | |
757 | JMP I NU /GO HOME | |
758 | BB, 0 | |
759 | JMS MR /MORE? | |
760 | TAD ARGUMT# | |
761 | SNA CLA /IF ARG=0, | |
762 | JMS WH /END RECORD AND RETURN TO USERS PROGRAM | |
763 | TAD IO /TEST IN OUT SWITCH | |
764 | SZA CLA /OUTPUT | |
765 | INC BB /INPUT | |
766 | JMP I BB | |
767 | AX, JMS GLST | |
768 | AA, TAD N2 | |
769 | CIA | |
770 | DCA CX | |
771 | JMSKP BB | |
772 | JMP AR | |
773 | AS, JMS GADR /GET CHARACTER ADDRESS | |
774 | TADI 7 | |
775 | SZL | |
776 | JMP ASNORT | |
777 | RTR | |
778 | RTR | |
779 | RTR | |
780 | ASNORT, AND (77 /MASK 6 BITS | |
781 | JMS PRINT | |
782 | ISZ CX | |
783 | JMP AS /LOOP FOR CHARACTER COUNT | |
784 | JMP AX /GET NEXT ARGUMENT(IF ANY) | |
785 | ||
786 | AR, JMS GCHR | |
787 | DCA DH /GET AND SAVE INPUT CHAR | |
788 | JMS GADR /GET CHARACTER POINTER | |
789 | TAD DH | |
790 | SZL /WHICH HALF? | |
791 | JMP ARNORT /RIGHT HALF | |
792 | IAC | |
793 | RTL | |
794 | RTL | |
795 | RTL | |
796 | SKP | |
797 | ARNORT, TADI 7 | |
798 | TAD (7740 /CANCEL BLANK CHAR | |
799 | ARCOMN, DCAI 7 | |
800 | ISZ CX | |
801 | JMP AR | |
802 | JMP AX | |
803 | ||
804 | GADR, 0 /SUBR TO COMPUTE CHARACTER ADDR FOR "A" FMT | |
805 | TAD ARGUMT | |
806 | DCA AS1 | |
807 | TAD N2 | |
808 | TAD CX | |
809 | CLL RAR | |
810 | TAD ARGUMT# /AC=WORD POINTER, LINK=LEFT/RIGHT FLAG | |
811 | DCA 7 | |
812 | AS1, NOP /SET UP DATA FIELD OF ARGUMENT | |
813 | JMPI GADR | |
814 | CX, 0 | |
815 | ||
816 | DH, 0 | |
817 | DCA CX /DIVIDE FPAC BY TEN CX TIMES | |
818 | JMP DTA | |
819 | DTB, CALL 1,FDV | |
820 | ARG TN | |
821 | DTA, ISZ CX | |
822 | JMP DTB | |
823 | JMP I DH | |
824 | AS3, CLA /PRINT ASTERISKS FOR WHOLE FIELD SIZE | |
825 | TAD N3 /GET FIELD SIZE, E OR F | |
826 | CMA | |
827 | DCA CX /-COUNT | |
828 | JMP QQ | |
829 | QQA, TAD (52 /PRINT CX ASTERISKS | |
830 | JMS PRINT | |
831 | QQ, ISZ CX /INDEX COUNT | |
832 | JMP QQA | |
833 | JMS GLST /TEST FOR MORE | |
834 | JMP PR2 /RETURN TO FORMAT PROCESSOR, SAME TYPE | |
835 | \f PAGE /EXPERIMENTAL | |
836 | IN, TAD N2 /INTEGER INPUT, GET WIDTH OF FIELD | |
837 | CMA /1,S COMP TO COUNTER, CR | |
838 | DCA CR | |
839 | CMA | |
840 | VQ, DCA WHI /-1 TO NUMBER ACCUMULATED | |
841 | CMA /-1 TO SIGN | |
842 | RRSIGN, DCA SN | |
843 | DCA SACH | |
844 | RRS, ISZ CR /HAS WHOLE NUMBER BEEN ACCUMULATED | |
845 | SKP | |
846 | JMP PRO | |
847 | JMS GCHR | |
848 | CPAGE 14 | |
849 | JMS CHTYPE /CLASSIFY CHARACTER | |
850 | DIGIT /ITS A DIGIT | |
851 | -40; RRS | |
852 | -53; RRS | |
853 | -55; RRSIGN | |
854 | 0; ERR2 | |
855 | DIGIT, JMS DGT /ACCUMULATE DIGIT INTO SACH | |
856 | JMP RRS /GET NEXT DIGIT | |
857 | PRO, TAD SACH /WE HAVE AN INTEGER ... | |
858 | ISZ WHI /WHAT KIND? | |
859 | JMP PRO2 | |
860 | ISZ SN / 'I' FORMAT | |
861 | CIA | |
862 | DCA I ARGUMT | |
863 | ||
864 | IX, CLA | |
865 | JMS GLST /INTEGER CONVERSION | |
866 | II, JMSKP BB /TEST MORE AND NON ZERO CURRENT LIST ITEM | |
867 | JMP IN /INPUT | |
868 | TAD AB | |
869 | DCA SACL /OUTPUT | |
870 | TAD (-4 | |
871 | DCA WHI /-4 | |
872 | DCA SN /0 | |
873 | TAD I ARGUMT | |
874 | SMA /SET SN 0 FOR PLUS, 1 FOR MINUS | |
875 | JMP XZ /PLACE MAGNITUDE IN 20 | |
876 | CIA | |
877 | ISZ SN | |
878 | XZ, CALL 1,DIV | |
879 | ARG TW | |
880 | DCA SACH | |
881 | CPAGE 4 | |
882 | CALL 0,IREM /IREM NEEDS AN ARGUMENT TO IGNORE | |
883 | AB, I1 | |
884 | WHI, 0 | |
885 | ||
886 | ||
887 | DCA I SACL /SAVE REMAINDER | |
888 | CMA | |
889 | TAD SACL /SACL=SACL-1 | |
890 | DCA SACL | |
891 | ISZ WHI /INDEX COUNT | |
892 | TAD SACH /AND CHECK NUM FOR 0 | |
893 | SZA | |
894 | JMP XZ /CYCLE | |
895 | IB, TAD N2 | |
896 | DCA N3 /IN CASE OF OVERFLOW | |
897 | TAD N2 | |
898 | CMA | |
899 | TAD WHI | |
900 | TAD (4 /COMPUTE NUMBER OF LEADING BLANKS | |
901 | JMS SA /PRINT LEADING BLANKS AND SIGN | |
902 | ID, INC SACL /POINT TO DIGIT TO PRINT NEXT | |
903 | TAD I SACL /GET IT | |
904 | SPA /TERMINATOR? | |
905 | JMP IX /YUP | |
906 | TAD (60 | |
907 | JMS PRINT /NOPE - PRINT THE DIGIT | |
908 | JMP ID /GET NEXT | |
909 | ||
910 | DGT, 0 | |
911 | DCA SACM | |
912 | TAD SACH | |
913 | CLL RTL | |
914 | TAD SACH | |
915 | RAL | |
916 | TAD SACM | |
917 | DCA SACH | |
918 | JMP I DGT | |
919 | ||
920 | END | |
921 | \f |