Commit | Line | Data |
---|---|---|
7af5ad59 PH |
1 | /FORTRAN IV RUNTIME SYSTEM, V5A |
2 | / | |
3 | / | |
4 | / | |
5 | / | |
6 | / | |
7 | / | |
8 | / | |
9 | // | |
10 | / | |
11 | / | |
12 | / | |
13 | / | |
14 | /COPYRIGHT (C) 1974,1975 | |
15 | /DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. | |
16 | / | |
17 | / | |
18 | / | |
19 | /THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A | |
20 | /SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU- | |
21 | /SION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR ANT OTHER | |
22 | /COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE | |
23 | /TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO | |
24 | /AGREES TO THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE | |
25 | /SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC. | |
26 | / | |
27 | / | |
28 | /THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT | |
29 | /NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL | |
30 | /EQUIPMRNT COROPATION. | |
31 | / | |
32 | /DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS | |
33 | /SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. | |
34 | / | |
35 | / | |
36 | / | |
37 | / | |
38 | / | |
39 | / | |
40 | \f/FORTRAN 4 RUNTIME SYSTEM - R.LARY | |
41 | /AND NOW WITH DOUBLE PRECISION! - MKH | |
42 | /RTS-8 SUPPORT ADDED 5/20/74 - RL | |
43 | /LAST EDITED 5/19/74 | |
44 | ||
45 | XVERSN=5 /UPDATE WITH EVERY RELEASE! | |
46 | XPATCH="A /PATCH LEVEL A | |
47 | ||
48 | /NOTES TO MAINTAINERS: | |
49 | ||
50 | /THIS PROGRAM IS DESIGNED TO SUPPORT MANY DIFFERENT HARDWARE | |
51 | /CONFIGURATIONS IN A MINIMAL AMOUNT OF SPACE. IT ACHIEVES THIS GOAL | |
52 | /BY "TAILORING" ITSELF AT INITIALIZATION TIME | |
53 | /BASED ON A SURVEY OF ITS HARDWARE/SOFTWARE ENVIRONMENT. THIS MAKES | |
54 | /THIS PROGRAM DIFFICULT TO MODIFY UNLESS THE MODIFYING PROGRAMMER | |
55 | /KNOWS WHAT IS GOING ON. IT IS THEREFORE SUGGESTED THAT YOU READ THIS | |
56 | /LISTING THOROUGHLY AND UNDERSTAND THE MAJOR ROUTINES BEFORE | |
57 | /MAKING EVEN "TRIVIAL" CHANGES. | |
58 | ||
59 | /ALL SYMBOLS BEGINNING WITH THE LETTER "Q" ARE ENTRIES IN THE | |
60 | /HEADER BLOCK OF THE LOADER-IMAGE (.LD) FILE. | |
61 | ||
62 | /ALL SYMBOLS BEGINNING WITH THE LETTER "Y" DENOTE THE BEGINNING OF | |
63 | /A BLOCK OF CODE WHICH WILL BE REPLACED BY DIFFERENT CODE IF FRTS | |
64 | /IS RUNNING IN THE BACKGROUND UNDER RTS-8. THE REPLACEMENT CODE | |
65 | /CAN BE FOUND IN THE TABLE "BKRLST". | |
66 | ||
67 | /ALL SYMBOLS BEGINNING WITH THE LETTER "V" ARE DEFINED IN THE LOADER | |
68 | /SYMBOL TABLE AND CANNOT BE MOVED WITHOUT CHANGING THE LOADER. ONLY | |
69 | /A VERY FEW OF THESE SYMBOLS OCCUR IN PLACES OTHER THAN | |
70 | /PAGE 200 OR THE FIRST LOCATION OF OTHER PAGES. | |
71 | ||
72 | /CODE WHICH CONTAINS THE CHARACTER SEQUENCE "*K*" IN THE COMMENT FIELD | |
73 | /IS PARTICULARLY SUBTLE/OBSCURE (THE "K" IS FOR "KLUDGE"). THE REST OF THE | |
74 | /COMMENT SHOULD INDICATE WHAT IS GOING ON. | |
75 | / | |
76 | / | |
77 | / FIXES FOR V4 J.K. 1975 | |
78 | / | |
79 | / .SCALE FACTOR PRINTED BY P FORMAT OPERATOR | |
80 | / .FRTS /P | |
81 | / .RK8E HANDLER TO RUN WITH INTERRUPTS ON | |
82 | / .SLASH AT END OF FORMAT STATEMENT | |
83 | / | |
84 | / | |
85 | / CHANGES FOR OS/78 AND OS/8 V3D BY P.T. | |
86 | / .CHANGED THE VERSION NUMBER TO 5A | |
87 | / .FIXED THE FIELD OVERFLOW PROBLEM | |
88 | / .FIXED THE "K=K+1" PROBLEM | |
89 | \f/DEFINITIONS: | |
90 | ||
91 | AC7775= STA CLL RTL | |
92 | AC7776= STA CLL RAL | |
93 | AC4000= CLA STL RAR | |
94 | AC3777= STA CLL RAR | |
95 | AC2000= CLA STL RTR | |
96 | AC0002= CLA STL RTL | |
97 | ||
98 | /DEFINITIONS OF KE-8/E INSTRUCTIONS | |
99 | ||
100 | MQL= 7421 | |
101 | MQA= 7501 | |
102 | CAM= CLA MQL | |
103 | SWP= MQA MQL | |
104 | SWAB= 7431 | |
105 | SCA= 7441 | |
106 | MUY= 7405 | |
107 | DVI= 7407 | |
108 | NMI= 7411 | |
109 | SHL= 7413 | |
110 | ASR= 7415 | |
111 | LSR= 7417 | |
112 | ACS= 7403 | |
113 | SAM= 7457 | |
114 | DAD= 7443 | |
115 | DLD= 7663 | |
116 | DST= 7445 | |
117 | DPIC= 7573 | |
118 | DCM= 7575 | |
119 | DPSZ= 7451 | |
120 | SGT= 6006 | |
121 | ||
122 | /DEFINITIONS OF FPP IOT'S | |
123 | ||
124 | FPINT= 6551 | |
125 | FPICL= 6552 | |
126 | FPCOM= 6553 | |
127 | FPHLT= 6554 | |
128 | FPST= 6555 | |
129 | FPRST= 6556 | |
130 | \f/FPP OPCODES: | |
131 | ||
132 | FLDA= 0000 | |
133 | FADD= 1000 | |
134 | FSUB= 2000 | |
135 | FDIV= 3000 | |
136 | FMUL= 4000 | |
137 | FADDM= 5000 | |
138 | FSTA= 6000 | |
139 | FMULM= 7000 | |
140 | LONG= 400 /TWO-WORD ADDRESSING | |
141 | BASE= 200 /BASEPAGE ADDRESSING | |
142 | IND= 600 /INDIRECT ADDRESSING | |
143 | ||
144 | FEXIT= 0000 | |
145 | FNORM= 0004 | |
146 | STARTF= 0005 | |
147 | STARTD= 0006 | |
148 | JAC= 0007 | |
149 | XTA= 0030 | |
150 | STARTE= 0050 | |
151 | LDX= 0100 | |
152 | ||
153 | JA= 1030 | |
154 | JNE= 1040 | |
155 | TRAP3= 3000 | |
156 | ||
157 | /OS8 EQUIVALENCES: | |
158 | ||
159 | OS8SWS= 7643 | |
160 | OSJSWD= 7746 | |
161 | OS8DVT= 7647 | |
162 | OS8DCB= 7760 | |
163 | OS8DAT= 7666 | |
164 | ||
165 | /VARIOUS OTHER IOT'S: | |
166 | ||
167 | LSF= 6661 | |
168 | LCF= 6662 | |
169 | LSE= 6663 | |
170 | LIE= 6665 | |
171 | LLS= 6666 | |
172 | LIF= 6667 | |
173 | \f/PAGE ZERO FOR FORTRAN IV RTS | |
174 | ||
175 | *0 /INTERRUPT STUFF | |
176 | 0 | |
177 | JMP I .+1 | |
178 | INTRPT | |
179 | LPGET, LPBUFR /LINE PRINTER RING BUFFER FETCH POINTER | |
180 | TOCHR, 0 /TELETYPE STATUS WORD | |
181 | KBDCHR, 0 /KEYBOARD INPUT CHARACTER | |
182 | POCHR, 0 /P.T. PUNCH COMPLETION FLAG | |
183 | RDRCHR, 0 /P.T. READER STATUS | |
184 | FMTPXR, 0 /XR USED TO INDEX FORMAT PARENTHESIS ARRAY | |
185 | INXR, INBUFR-1 /XR USED TO GET CHARS FROM INPUT LINE | |
186 | XR, 0 | |
187 | XR1, 0 | |
188 | ||
189 | *16 | |
190 | VEOFSW, 0 /USED BY "EOFCHK" TO STORE VARIABLE ADDRESS | |
191 | 0 /*K* MUST BE IN AUTO - XR | |
192 | T, 0 /TEMPORARY | |
193 | DFLG, 0 /0 = F.P., 1 = D.P. | |
194 | INST, 0 /CURRENT INSTRUCTION WORD | |
195 | ||
196 | /IOH PAGE ZERO LOCATIONS | |
197 | ||
198 | RWFLAG, 0 /READ/WRITE FLAG | |
199 | FMTTYP, 0 /TYPE OF CONVERSION BEING DONE | |
200 | EOLSW, 0 /EOL SW ON INPUT - CHAR POS ON OUTPUT | |
201 | N, 0 /REPEAT FACTOR | |
202 | W, 0 /FIELD WIDTH | |
203 | D, 0 /NUMBER OF PLACES AFTER DECIMAL POINT | |
204 | ||
205 | DATCDF, 0 /SUBROUTINE TO CHANGE DATA FIELD | |
206 | DATAF, 0 /CONTAINS VARIOUS CDF'S | |
207 | JMP I DATCDF /RETURN | |
208 | ||
209 | ERR, ERROR /POINTER TO ERROR ROUTINE | |
210 | FATAL, 0 /FATAL ERROR FLAG - 0=FATAL | |
211 | MCDF, MAKCDF | |
212 | ||
213 | /FPP PARAMETER TABLE LOCATIONS: | |
214 | ||
215 | APT, 0 /VARIOUS FIELD BITS FOR FPP | |
216 | PC, DPTEST /FPP PROGRAM COUNTER | |
217 | XRBASE, 0 /FPP INDEX REGISTER ARRAY ADDRESS | |
218 | BASADR, 0 /FPP BASE PAGE ADDRESS | |
219 | ADR, 0 /ADDRESS TEMPORARY | |
220 | ACX, 0 | |
221 | ACH, 0 /*** FLOATING ACCUMULATOR *** | |
222 | ACL, 0 | |
223 | EAC1, 0 | |
224 | EAC2, 0 /** FOR EXTENDED PRECISION OPTION ** | |
225 | EAC3, 0 | |
226 | \f/FLOATING POINT PACKAGE LOCATIONS | |
227 | ||
228 | AC0, 0 | |
229 | AC1, 0 /FLOATING AC OVERFLOW WORD | |
230 | AC2, 0 /OPERAND OVFLOW WORD | |
231 | OPX, 0 | |
232 | OPH, 0 /*** FLOATING OPERAND REGISTER *** | |
233 | OPL, 0 | |
234 | ||
235 | /RTS I/O CONVERSION SYSTEM LOCATIONS | |
236 | ||
237 | FMTBYT, 0 /FORMAT BYTE POINTER | |
238 | IFLG, 0 /I FOEMAT FLAG | |
239 | GFLG, 0 /G FORMAT FLAG | |
240 | EFLG, 0 /E FORMAT FLAG - SOMETIMES ON FOR G FMT | |
241 | OD, 0 | |
242 | SCALE, 0 | |
243 | PFACT, 0 /P-SCALE FACTOR | |
244 | PFACTX, 0 /TEMP FOR PFACT | |
245 | ACI, 0 /INTEGERIZED FAC FROM "FFIX" SUBR | |
246 | CHCH, 0 | |
247 | FMTNUM, 0 /CONTAINS ACCUMULATED NUMERIC VALUE | |
248 | CTCINH, 0 /^C INHIBIT FLAG | |
249 | LOGUNT, 0 /DSRN POINTER - ONLY USED FROM ONE PAGE! | |
250 | PTTY, TTY /POINTER TO TTY HANDLER - USED BY LDDSRN | |
251 | 0 / SO FORMS CONTROL WILL WORK ON UNIT 0 | |
252 | FPNXT, ICYCLE /USED AS INTERPRETER ADDRESS IF NO FPP | |
253 | ||
254 | /DSRN IMAGE | |
255 | ||
256 | HAND, 0 /HANDLER ENTRY POINT | |
257 | HCODEW, 0 /HANDLER LOAD ADDR & FIELD + IOFFLG + FORMS CTL FLG | |
258 | BADFLD, 0 /BUFFER ADDRESS AND FIELD | |
259 | CHRPTR, 0 /ACTUALLY A WORD POINTER | |
260 | CHRCTR, 0 /COUNTER - RANGES FROM -3 TO -1 | |
261 | STBLK, 0 /STARTING BLOCK OF FILE | |
262 | RELBLK, 0 /CURRENT RELATIVE BLOCK NUMBER | |
263 | TOTBLK, 0 /LENGTH OF FILE | |
264 | FFLAGS, 0 /FILE FLAGS: | |
265 | /BIT 0 - "HAS BEEN WRITTEN" FLAG | |
266 | /BITS 1-2 - FORMATTED/UNFORMATTED FLAGS | |
267 | /BIT 11 - "END-FILED" FLAG | |
268 | ||
269 | BUFFLD, 0 /ROUTINE TO SET DF TO BUFFER FIELD | |
270 | BUFCDF, HLT | |
271 | JMP I BUFFLD | |
272 | ||
273 | FADD1, FADD+LONG /FPP CODE TO ADD 1.0 TO FAC | |
274 | ONE /AND FALL INTO STORE CODE | |
275 | FGPBF, 0 /THESE THREE WORDS ARE USED | |
276 | BIOPTR, 0 /TO FETCH AND STORE FLOATING POINT NUMBERS | |
277 | FEXIT /FROM RANDOM MEMORY | |
278 | PAGE | |
279 | \f/STARTUP CODE | |
280 | ||
281 | FTEMP2, ISZ .+3 /ALSO USED AS I/O F.P. TEMPORARY | |
282 | CDF CIF 10 | |
283 | JMP I .+1 | |
284 | VDATE, RTSLDR /USED TO STORE OS/8 DATE | |
285 | ||
286 | /RTS ENTRY POINTS - "VERSION INDEPENDENT" | |
287 | ||
288 | VUERR, JMP I (USRERR /USER ERROR | |
289 | /** LOADER MUST DEFINE #ARGER AS VARGER-1 ** | |
290 | VARGER, JMS I ERR /LIBRARY ARGUMENT ERROR | |
291 | VRENDO, ISZ RWFLAG /END OF I/O LIST | |
292 | VRFSV, JMP I GETLMN /I/O LIST ARG ENTRY - COROUTINE WITH GETLMN | |
293 | VBAK, JMP I (BKSPC /"BACKSPACE" ROUTINE | |
294 | VENDF, JMP I (ENDFL /"END FILE" ROUTINE | |
295 | VREW, JMP I (RWIND /"REWIND" ROUTINE | |
296 | VDEF, JMP I (DFINE /"DEFINE FILE" ROUTINE | |
297 | VWUO, AC4000 /UNFORMATTED WRITE | |
298 | VRUO, JMP I (RWUNF /UNFORMATTED READ | |
299 | VWDAO, AC4000 /DIRECT ACCESS WRITE | |
300 | VRDAO, JMP I (RWDACC /DIRECT ACCESS READ | |
301 | VWRITO, AC4000 /FORMATTED (ASCII) WRITE | |
302 | VREADO, JMP I (RWASCI /FORMATTED (ASCII) READ | |
303 | VSWAP, JMP I (SWAP /OVERLAY PROCESSOR | |
304 | VEXIT, TRAP3; CALXIT /"STOP" ROUTINE - ENTERED IN FPP MODE | |
305 | V8OR12, 0;0 /0;1 IF CPU IS A PDP-12 | |
306 | VBACKG, JMP I (NULLJB /BACKGROUND JOB DISPATCHER | |
307 | 0 | |
308 | CDF CIF 0 /USED BY ROUTINE "ONQB" IN LIBRARY | |
309 | JMS I .-2 | |
310 | JMP VBACKG | |
311 | ||
312 | /IOH GET VARIABLE ROUTINE. | |
313 | /THIS ROUTINE MAKES THE FORMATTED I/O PROCESSOR AND THE USER'S | |
314 | /PROGRAM CO-ROUTINES (DEF(COROUTINE)= 2 ROUTINES EACH THINKING THE OTHER | |
315 | / IS A SUBROUTINE). ON ENTRY FAC=INPUT NUMBER | |
316 | /IF I/O IS A READ, ON RETURN FAC=OUTPUT NUMBER IF I/O IS A WRITE. | |
317 | ||
318 | GETLMN, 0 | |
319 | VRETRN, JMP I [RETURN /SHORT ROUTINE FOR ALL THOSE COMMENTS, NO? | |
320 | \f/INTERRUPT DRIVEN I/O HANDLERS | |
321 | ||
322 | LPT, 0 /RING-BUFFERED - LP08 OR LS8E | |
323 | AND [377 /JUST IN CASE | |
324 | LPTSNA, SNA | |
325 | JMP I (IOERR /CANNOT BE USED FOR INPUT | |
326 | YLPT, IOF | |
327 | DCA I LPPUT | |
328 | TAD LPGET | |
329 | CIA | |
330 | TAD LPPUT | |
331 | SZA CLA /IS LPT QUIET? | |
332 | JMP .+3 /NO | |
333 | TAD I LPPUT | |
334 | LLS /YES - START 'ER UP | |
335 | CLA IAC | |
336 | LIE /ENABLE LPT INTERRUPTS | |
337 | TAD LPPUT /1 IN AC, REMEMBER? | |
338 | DCA LPPUT | |
339 | TAD I LPPUT | |
340 | SPA | |
341 | JMP .-3 /NEGATIVE NUMBERS ARE BUFFER LINKS | |
342 | SZA CLA /ANY ROOM LEFT IN BUFFER? | |
343 | JMS I (HANG | |
344 | LPUHNG /WAIT FOR LINE PRINTER | |
345 | ION /TURN INTERRUPTS BACK ON | |
346 | JMP I LPT /RETURN | |
347 | ||
348 | LPPUT, LPBUFR | |
349 | ||
350 | PTP, 0 /PAPER TAPE PUNCH HANDLER | |
351 | YPTP, SNA | |
352 | JMP I (IOERR /INPUT IS ERROR | |
353 | DCA LPT /SAVE CHAR | |
354 | IOF | |
355 | TAD POCHR /IF PUNCH IS NOT IDLE, | |
356 | SZA CLA /WE DISMISS JOB | |
357 | JMS I (HANG | |
358 | PPUHNG /WAIT FOR PUNCH INTERRUPT | |
359 | TAD LPT | |
360 | PLS /OUTPUT CHAR | |
361 | DCA POCHR /SET FLAG NON-ZERO | |
362 | ION | |
363 | JMP I PTP | |
364 | ||
365 | /*K* THE FOLLOWING ADDRESSES GET FALLEN INTO & MUST BE SMALL | |
366 | ||
367 | IFNZRO PPUHNG&7000 <__ERROR__> | |
368 | IFNZRO TTUHNG&7000 <__ERROR__> | |
369 | IFNZRO KBUHNG&7000 <__ERROR__> | |
370 | IFNZRO RDUHNG&7000 <__ERROR__> | |
371 | IFNZRO LPUHNG&7000 <__ERROR__> | |
372 | \f/INTERRUPT-DRIVEN PTR AND TELETYPE HANDLER | |
373 | ||
374 | PTR, 0 /CRUDE READER HANDLER | |
375 | YPTR, SZA CLA | |
376 | JMP I (IOERR /OUTPUT ILLEGAL TO PTR | |
377 | IOF | |
378 | RFC /START READER | |
379 | JMS I (HANG | |
380 | RDUHNG /HANG UNTIL COMPLETE | |
381 | TAD RDRCHR /GET CHARACTER | |
382 | ION | |
383 | JMP I PTR /RETURN | |
384 | ||
385 | TTY, 0 /BUFFERS 2 CHARS ON OUTPUT, 1 ON INPUT | |
386 | YTTY, IOF /DELICATE CODE AHEAD | |
387 | SNA /INPUT OR OUTPUT? | |
388 | JMP KBD /INPUT | |
389 | DCA LPT /OUTPUT - SAVE CHAR | |
390 | TAD TOCHR /GET TTY STATUS | |
391 | SMA SZA CLA /G.T. 0 MEANS A CHAR IS BACKED UP | |
392 | JMS I (HANG | |
393 | TTUHNG /WAIT FOR LOG JAM TO CLEAR | |
394 | TAD TOCHR /NO CHAR BACKED UP - SEE IF TTY BUSY | |
395 | CLL RAL /"BUSY" FLAG IN LINK - INTERRUPTS ARE OFF! | |
396 | CLA CML RAR /COMPLEMENT OF BUSY IN SIGN | |
397 | TAD LPT /GET CHAR | |
398 | SPA /IF TTY NOT BUSY, | |
399 | TLS /OUTPUT CHAR | |
400 | DCA TOCHR /STORE POS OR NEG, BACKED UP OR BUSY | |
401 | TTYRET, ION /TURN INTERRUPTS BACK ON | |
402 | JMP I TTY /AND LEAVE | |
403 | \fKBD, TAD KBDCHR /HAS A CHARACTER BEEN INPUT? | |
404 | SNA CLA | |
405 | JMS I (HANG | |
406 | KBUHNG /NO - RUN BACKGROUND UNTIL ONE IS | |
407 | TAD KBDCHR /GET CHARACTER | |
408 | DCA LPT | |
409 | DCA KBDCHR /CHEAR CHARACTER BUFFER | |
410 | TAD LPT | |
411 | JMP TTYRET /RETURN WITH INTERRUPTS ON | |
412 | ||
413 | KILFPP, FPHLT /BRING FPP TO A SCREECHING HALT | |
414 | ISZ .-1 | |
415 | JMP .-1 /WAIT FOR IT TO STOP | |
416 | FPICL /CLEAN UP MESS HALT HAS MADE IN FPP | |
417 | BEEORC, SZL /^C OR ^B? | |
418 | JMP I (7600 /^C - HIYO SILVER, AWAY! | |
419 | KCC /CLEAR KBD FLAG ON ^B | |
420 | CTLBER, JMS I ERR /*** THIS MAY BE DANGEROUS! ** | |
421 | PAGE | |
422 | \f/INTERRUPT SERVICE ROUTINES | |
423 | ||
424 | INTRPT, DCA INTAC | |
425 | RAR | |
426 | DCA INTLNK | |
427 | VINT, JMP .+4 /** MUST BE AT 403 ** | |
428 | IFNZRO VINT-403 <___ CHANGE LOADER!!!> | |
429 | 0 | |
430 | CDF CIF 0 /USER INTERRUPT ROUTINE GOES HERE | |
431 | JMS I .-2 | |
432 | ||
433 | FPINT /CHECK FOR FPP DONE | |
434 | JMP LPTEST | |
435 | FPUHNG, JMP DISMIS /ALWAYS GOES TO RESTRT | |
436 | ||
437 | VDISMS, JMP DISMIS /FOR USE BY USERS | |
438 | JMP DISMIS | |
439 | JMP DISMIS | |
440 | ||
441 | LPTEST, LSF | |
442 | JMP NOTLPT | |
443 | LPTLCF, LCF /CLEAR FLAG | |
444 | TAD I LPGET | |
445 | SNA CLA /CHECK FOR SPURIOUS INTERRUPT | |
446 | JMPDIS, JMP DISMIS /GO AWAY IF SO | |
447 | DCA I LPGET /ZERO CHAR JUST OUTPUT | |
448 | ISZ LPGET | |
449 | TAD I LPGET | |
450 | SPA | |
451 | DCA LPGET /TAKE CARE OF BUFFER LINKS | |
452 | SNA | |
453 | TAD I LPGET /MAKE SURE CHAR IS IN AC | |
454 | SZA /IS THERE A CHARACTER? | |
455 | LLS /YES - PRINT IT | |
456 | CLA | |
457 | LSF /CHECK FOR IMMEDIATE FLAG | |
458 | LPUHNG, JMP DISMIS /NO - MAYBE RESTART PROGRAM | |
459 | JMP LPTLCF /YES - LOOP | |
460 | ||
461 | NOTLPT, TSF /CHECK TTY | |
462 | JMP NOTTTY | |
463 | TCF /CLEAR FLAG | |
464 | TAD TOCHR /GET TTY STATUS | |
465 | SMA SZA /IF THERE IS A CHARACTER WAITING, | |
466 | TLS /OUTPUT IT. | |
467 | SMA SZA CLA /CHANGE "WAITING" TO "BUSY", | |
468 | STL RAR /"BUSY" TO "IDLE". | |
469 | DCA TOCHR | |
470 | TTUHNG, JMP DISMIS | |
471 | \f/KBD AND PTP INTERRUPTS | |
472 | ||
473 | NOTTTY, KSF | |
474 | JMP NOTKBD | |
475 | TAD [200 | |
476 | KRS /USE KRS TO FORCE PARITY BIT | |
477 | DCA KBDCHR /AND ALSO SO THAT ^C WILL STILL BE IN BUFFER IN OS/8 | |
478 | TAD KBDCHR | |
479 | TAD (-202 /CHECK FOR ^C OR ^B | |
480 | CLL RAR | |
481 | SNA CLA | |
482 | JMP CTCCTB /YUP - TAKE SOME DRASTIC ACTION | |
483 | KCC /DATA CHARACTER - CLEAR FLAG | |
484 | KBUHNG, JMP DISMIS | |
485 | ||
486 | CTCCTB, TAD CTCINH | |
487 | SNA CLA /ARE WE IN A HANDLER? | |
488 | JMP NOTINH /NO | |
489 | TAD INTLNK | |
490 | CLL RAL /YES - RETURN WITH INTERRUPTS OFF | |
491 | TAD INTAC /TRUST IN GOD AND RTS | |
492 | RMF | |
493 | JMP I 0 | |
494 | ||
495 | NOTKBD, PSF | |
496 | JMP NOTPTP | |
497 | PCF /P.T. PUNCH INTERRUPT - CLEAR FLAG | |
498 | DCA POCHR /CLEAR SOFTWARE FLAG | |
499 | PPUHNG, JMP DISMIS | |
500 | ||
501 | NOTPTP, RSF | |
502 | JMP LPTERR | |
503 | TAD [200 | |
504 | RRB /GET RDR CHAR | |
505 | DCA RDRCHR | |
506 | RDUHNG, JMP DISMIS | |
507 | ||
508 | LPTERR, LSE /TEST FOR LP08 ERROR FLAG | |
509 | SKP | |
510 | LIF /DISABLE LP08 INTERRUPTS IF ERROR FLAG ON | |
511 | DISMIS, TAD INTLNK | |
512 | CLL RAL | |
513 | TAD INTAC /RESTORE AC AND LINK | |
514 | RMF | |
515 | ION | |
516 | JMP I 0 /RETURN FROM THE INTERRUPT | |
517 | ||
518 | INTAC, 0 | |
519 | INTLNK, 0 | |
520 | \f/BACKGROUND INITIATE/TERMINATE ROUTINE | |
521 | ||
522 | HANG, 0 /ALWAYS CALLED WITH INTERRUPTS OFF! | |
523 | TAD I HANG /GET POINTER TO UNHANGING LOCATION | |
524 | DCA UNHANG | |
525 | RDF /GET FIELD CALLED FROM | |
526 | TAD HCIDF0 | |
527 | DCA HNGCDF /SAVE FOR RETURN | |
528 | HCIDF0, CDF CIF 0 | |
529 | TAD (JMP RESTRT /CHANGE THE "JMP DISMIS" AT THAT LOC | |
530 | DCA I UNHANG /TO A "JMP RESTRT" | |
531 | TAD BACKLK | |
532 | CLL RAL | |
533 | TAD BACKAC /SET UP BACKGROUND AC AND LINK | |
534 | BAKCIF, CIF 0 | |
535 | BAKCDF, CDF 0 | |
536 | ION | |
537 | JMP I BACKPC /INITIATE BACKGROUND | |
538 | ||
539 | / COME HERE WHEN THE HANG CONDITION HAS GONE AWAY | |
540 | ||
541 | RESTRT, TAD JMPDIS /RESTORE THE UNHANG LOCATION | |
542 | DCA I UNHANG | |
543 | TAD INTAC /SUSPEND THE BACKGROUND | |
544 | DCA BACKAC | |
545 | TAD INTLNK | |
546 | DCA BACKLK | |
547 | TAD 0 | |
548 | DCA BACKPC | |
549 | RIB | |
550 | AND [70 | |
551 | TAD HCIDF0 | |
552 | DCA BAKCIF | |
553 | RIB | |
554 | JMS I MCDF /*K* OK SINCE BACKGROUND DOESN'T USE MAKCDF | |
555 | DCA BAKCDF | |
556 | ISZ HANG | |
557 | HNGCDF, HLT | |
558 | JMP I HANG /INTERRUPTS ARE OFF - RETURN | |
559 | ||
560 | NOTINH, TAD JMPDIS /IN CASE WE WERE HUNG, WE DON'T WANT | |
561 | DCA I UNHANG /TO GET "UNHUNG" OUT OF THE ERROR ROUTINE! | |
562 | JMP I (KILFPP /KILL FPP AND GO TO EXIT OR ERROR | |
563 | ||
564 | UNHANG, 0 | |
565 | BACKAC, 0 | |
566 | BACKLK, 0 | |
567 | BACKPC, VBACKG | |
568 | VHANG= HANG | |
569 | IFNZRO VHANG-0524 <__ CHANGE LOADER!> | |
570 | PAGE | |
571 | \f/I-O CONVERSION ROUTINES - STARTUP CODE | |
572 | ||
573 | RWASCI, JMS I [RWINIT /"READ(N,FMT)" OR "WRITE(N,FMT)" | |
574 | 2000 /"FORMATTED" BIT | |
575 | JMS I [FETPC /GET ADDRESS OF FORMAT STMT | |
576 | DCA FMTDF | |
577 | JMS I [FETPC | |
578 | DCA FMTADR | |
579 | DCA FMTTYP | |
580 | DCA PFACT /CLEAR SCALE FACTOR | |
581 | JMS I [GETLMN /EXIT TO MAIN PROGRAM TO GET 1ST VARIABLE | |
582 | ||
583 | TAD (FMTPDL-1 | |
584 | FMTSET, DCA FMTPXR /STORE NEW FORMAT PUSHDOWN POINTER | |
585 | TAD I FMTPXR | |
586 | DCA FMTBYT /GET NEW BYTE POINTER (NOTE-FMTPDL CONTAINS A 0) | |
587 | \f/MAIN FORMAT DECODING LOOP | |
588 | ||
589 | FMTFLP, TAD FMTBYT | |
590 | DCA FMPBYT /SAVE CURRENT BYTE PTR FOR PARENTHESES HACK | |
591 | FMTDLP, DCA FMTNUM /ZERO ACCUMULATED NUMBER | |
592 | FMTCLP, JMS FMTGCH /GET A CHARACTER | |
593 | ISZ FMTBYT /BUMP BYTE POINTER | |
594 | JMS I [CHTYPE /CLASSIFY CHAR | |
595 | 1234; FMTDIG /DIGIT | |
596 | -42; DBLQOT /" | |
597 | -44; ABORTO /$ | |
598 | -55; FMINUS /- | |
599 | -56; FMTPER /. | |
600 | -57; SLASH // | |
601 | -54; COMMA /, | |
602 | -50; LPAREN /( | |
603 | -51; RPAREN /) | |
604 | -47; KWOTE /' | |
605 | -40; FMTCLP /SPACE | |
606 | 0 /ANYTHING ELSE | |
607 | ||
608 | TAD FMTTYP | |
609 | SZA CLA /CHECK THAT WE DO NOT HAVE A FIELD OUTSTANDING | |
610 | JMP I (FMTERR /IF WE DO - ERROR | |
611 | TAD CHCH /GET FIELD CHARACTER | |
612 | DCA FMTTYP | |
613 | TAD FMTNUM | |
614 | SNA /IF REPEAT COUNT WAS MISSING OR ZERO | |
615 | IAC /MAKE IT ONE | |
616 | CMA | |
617 | DCA N /STORE -(REPEAT COUNT +1) | |
618 | DCA W /CLEAR WIDTH INITIALLY | |
619 | ISZ FMTNUM /PRECLUDE "FORMAT ERROR" ON X,P, OR H FORMATS | |
620 | TAD FMTTYP | |
621 | AND [7 /IS THE CHARACTER P, X, OR H? | |
622 | SNA CLA /IF SO, DON'T WAIT | |
623 | COMMA, JMS I (DOFMT /EXECUTE THE STORED FIELD SPECIFICATION | |
624 | JMP FMTFLP /BACK FOR MORE | |
625 | ||
626 | FMTADR, 0 /ADDRESS OF FORMAT | |
627 | \fFMTGCH, 0 /GET CHARACTER FROM FORMAT | |
628 | JMS FMTGAD /GET WORD CONTAINING CHAR AND L/R SWITCH | |
629 | CDF 0 | |
630 | JMS I (FMTGLR /EXTRACT CHARACTER | |
631 | JMP I FMTGCH | |
632 | ||
633 | FMTGAD, 0 /SUBR TO GET A WORD FROM A CHARACTER OFFSET | |
634 | TAD FMTBYT /GET OFFSET | |
635 | CLL RAR | |
636 | CLL | |
637 | TAD FMTADR /COMPUTE BASE ADDR + [OFFSET/2] | |
638 | DCA D | |
639 | RAL | |
640 | TAD FMTDF | |
641 | JMS I MCDF /SET UP PROPER DATA FIELD | |
642 | DCA .+1 | |
643 | HLT | |
644 | TAD FMTBYT | |
645 | RAR | |
646 | CLA /LEAVE L/R SWITCH IN LINK | |
647 | TAD I D | |
648 | JMP I FMTGAD /RETURN WITH WORD IN AC | |
649 | ||
650 | FMTDF, 0 /FIELD OF 1ST CHAR OF FORMAT IN BITS 9-11 | |
651 | ||
652 | FMTDIG, TAD FMTNUM /DIGIT PROCESSOR | |
653 | CLL RTL | |
654 | TAD FMTNUM | |
655 | CLL RAL /MULTIPLY FMTNUM BY 10 | |
656 | TAD CHCH /ADD IN THE DIGIT | |
657 | JMP FMTDLP /STORE IT BACK AND CONTINUE | |
658 | \f/PARENTHESIS AND DIGIT ROUTINES | |
659 | ||
660 | LPAREN, TAD FMTPXR | |
661 | TAD (2-FMTPDL | |
662 | SZA /ARE WE AT PARENTHESIS LEVEL 1? | |
663 | JMP .+3 /NO | |
664 | TAD FMPBYT /YES - STORE A POINTER TO THE FIRST DIGIT OF THE | |
665 | DCA I (FMTPDL-2 /GROUP COUNT PRECEDING THIS PAREN | |
666 | /AS THE LOOP POINTER FOR LEVEL 1 | |
667 | TAD [7 | |
668 | SPA CLA /PUSHDOWN OVERFLOW? | |
669 | FPOERR, JMS I ERR /YES | |
670 | AC7775 | |
671 | TAD FMTPXR | |
672 | DCA FMTPXR /BUMP PARENTHESIS PUSHDOWN POINTER | |
673 | TAD FMTBYT | |
674 | DCA I FMTPXR /SAVE BYTE POINTER | |
675 | TAD FMTNUM | |
676 | SNA | |
677 | IAC /NO GROUP COUNT MEANS COUNT = 1 | |
678 | CIA | |
679 | DCA I FMTPXR /SAVE LOOP COUNT | |
680 | DCA I (FMTPDL-1 /INITIAL GROUP COUNT IS INFINITE! | |
681 | RPLOOP, AC7776 /COME HERE ON RIGHT PAREN ALSO | |
682 | TAD FMTPXR /BACK UP FORMAT PDL POINTER | |
683 | JMP FMTSET /RESTORE FMTBYT FROM TOP OF LIST | |
684 | ||
685 | FMPBYT, 0 | |
686 | ||
687 | RPAREN, JMS I (DOFMT /EXECUTE PREVIOUS SPEC IF ANY | |
688 | TAD FMTPXR | |
689 | TAD (2-FMTPDL /IS THIS THE FINAL RIGHT PAREN? | |
690 | SNA CLA | |
691 | JMS I [ENDREC /YES - CHECK FOR END OF FORMAT | |
692 | ISZ I FMTPXR /BUMP COUNT | |
693 | JMP RPLOOP /DIDN'T OVERFLOW - LOOP TO BYTE AFTER ( | |
694 | ISZ FMTPXR /POP UP PARENTHESES STACK | |
695 | JMP FMTFLP /CONTINUE PAST RIGHT PAREN | |
696 | PAGE | |
697 | \f/QUOTE AND HOLLERITH FORMAT PROCESSORS | |
698 | ||
699 | KWOTE, TAD MINUS5 /APOSTROPHE PROCESSOR | |
700 | DBLQOT, TAD (-42 /QUOTE PROCESSOR | |
701 | DCA KWODEL /SAVE TERMINATOR | |
702 | JMS DOFMT /PROCESS PRECEDING FIELD , IF ANY | |
703 | SKP | |
704 | KWOTLP, JMS FMTHCV /PROCESS ONE CHARACTER | |
705 | JMS I [FMTGCH /GET THE NEXT FORMAT CHAR | |
706 | TAD KWODEL | |
707 | SZA CLA /IS IT THE TERMINATOR? | |
708 | JMP KWOTLP /NO - PROCESS IT AND CONTINUE | |
709 | ISZ FMTBYT /BUMP OVER TERMINATOR | |
710 | JMS I [FMTGCH | |
711 | TAD KWODEL | |
712 | SNA CLA /IS THIS ANOTHER TERMINATOR? | |
713 | JMP KWOTLP /TWO TERMINATORS PRINT AS ONE | |
714 | JMP I (FMTFLP /OTHERWISE GO BACK TO FORMAT LOOP | |
715 | ||
716 | HFMT, JMS MORE /MORE CHARACTERS? | |
717 | JMS FMTHCV /YES - PROCESS ONE | |
718 | JMP HFMT /AND LOOP | |
719 | ||
720 | FMTHCV, 0 /ROUTINE COMMON TO H AND QUOTED FORMATS | |
721 | TAD RWFLAG /PROCESSES ONE CHAR IN OR OUT OF THE FORMAT | |
722 | H7700, SMA CLA /IN OR OUT? | |
723 | JMP FMTHIN /IN | |
724 | JMS I [FMTGCH /OUT - GET THE CHAR | |
725 | JMS I [FMTOUT /PRINT IT | |
726 | JMP FMTHCR /RETURN | |
727 | FMTHIN, JMS I [FMTIN /INPUT - GET THE CHAR FROM THE INPUT LINE | |
728 | DCA W /SAVE IT | |
729 | JMS I (FMTGAD | |
730 | SZL /WHICH SIDE? | |
731 | JMP FHRGHT /RIGHT SIDE | |
732 | AND [77 /LEFT - KEEP RIGHT CHAR | |
733 | DCA MORE | |
734 | TAD W | |
735 | CLL RTL | |
736 | RTL | |
737 | RTL | |
738 | TAD MORE /ADD NEW CHAR IN ON THE LEFT | |
739 | JMP .+3 | |
740 | FHRGHT, AND H7700 /KEEP THE CHAR ON THE LEFT | |
741 | TAD W /ADD NEW CHAR IN ON THE RIGHT | |
742 | DCA I D /RESTORE ALTERED WORD | |
743 | CDF 0 | |
744 | FMTHCR, ISZ FMTBYT /BUMP BYTE POINTER | |
745 | JMP I FMTHCV | |
746 | ||
747 | KWODEL, 0 /MUST BE UNIQUE! | |
748 | \fMORE, 0 /SUBR TO BUMP REPEAT COUNT AND EXIT ON OVFLO | |
749 | ISZ N | |
750 | JMP I MORE | |
751 | DOFRTN, DCA FMTTYP /INDICATE NO SPECIFICATION COLLECTED | |
752 | JMP I DOFMT /RETURN FROM "DOFMT" | |
753 | ||
754 | DOFMT, 0 /ROUTINE TO PROCESS A FORMAT SPECIFICATION | |
755 | TAD FMTNUM /GET THE CURRENT NUMBER | |
756 | DCA D /STORE IT AS DECIMAL POINT SPEC | |
757 | DCA IFLG | |
758 | DCA EFLG | |
759 | DCA GFLG /ZERO CONVERSION FLAGS | |
760 | TAD FMTTYP | |
761 | SNA CLA /ANY SPECIFICATION WAITING? | |
762 | JMP I DOFMT /NO - JUST RETURN | |
763 | TAD W | |
764 | TAD D /IF THERE WAS NO W OR D SPECIFICATION, | |
765 | SNA CLA | |
766 | JMP FMTERR /ITS AN ERROR | |
767 | TAD FMTTYP | |
768 | JMS I [CHTYPE /YES - WHICH ONE? | |
769 | -30; XFMT /X | |
770 | -24; TFMT /T | |
771 | -20; PFMT /P | |
772 | -14; LFMT /L | |
773 | -11; IFMT /I | |
774 | -10; HFMT /H | |
775 | -7; GFMT /G | |
776 | -6; FFMT /F | |
777 | MINUS5, -5; EFMT /E | |
778 | -4;DF, EFMT /D - EQUIVALENT TO E IF NO D.P. FPP | |
779 | -2;BF, FFMT /B - EQUIVALENT TO F IF NO D.P. FPP | |
780 | -1; AFMT /A | |
781 | 0 /NONE OF THE ABOVE - ERROR | |
782 | FMTERR, JMS I ERR | |
783 | \fENDREC, 0 /ROUTINE TO END A LINE AND MAYBE THE I/O | |
784 | JMS I [EOLINE | |
785 | CLA IAC | |
786 | AND RWFLAG /LO BIT OF RWFLAG IS "I/O LIST EXHAUSTED" FLAG | |
787 | SNA CLA /SKIP IF NO MORE ELEMENTS IN I/O LIST | |
788 | JMP I ENDREC | |
789 | JMP I [ENDIO /NOW FINISH UP AND LEAVE | |
790 | ||
791 | SLASH, JMS DOFMT /EXECUTE THE FIELD SPEC IF ANY | |
792 | JMS I [EOLINE /TERMINATE CURRENT LINE | |
793 | JMP I (FMTFLP | |
794 | ||
795 | PFMT, CLA CMA | |
796 | TAD FMTNUM | |
797 | ISZ MINFLG /P FORMAT - CHECK FOR NEGATIVE SCALE | |
798 | CIA | |
799 | DCA PFACT | |
800 | STA /FALL INTO CODE TO CLEAR MINFLG | |
801 | DCA MINFLG /SET FLAG ON MINUS | |
802 | JMP DOFRTN | |
803 | ||
804 | FMINUS, JMS DOFMT /EXECUTE PRECEDING SPEC | |
805 | DCA MINFLG /CLEAR MINUS FLAG | |
806 | JMP I (FMTFLP | |
807 | ||
808 | MINFLG, -1 | |
809 | ||
810 | FMTPER, TAD FMTNUM /PERIOD PROCESSOR | |
811 | DCA W /STORE WIDTH | |
812 | JMP I (FMTFLP | |
813 | ||
814 | ABORTO, JMS DOFMT /$ - SPECIAL HACK TO ALLOW PROMPTS | |
815 | DCA EOLSW /FAKE BEGINNING OF LINE | |
816 | DCA I (TTYLF /INHIBIT LF BEFORE NEXT TTY INPUT | |
817 | JMP I [ENDIO /GO AWAY | |
818 | PAGE | |
819 | \fCHTYPE, 0 /ROUTINE TO CLASSIFY CHARACTERS | |
820 | DCA CHCH /SAVE CHAR | |
821 | JMP CHLOOP+1 | |
822 | CDIGIT, TAD CHCH /CHECK FOR DIGIT | |
823 | TAD (-72 | |
824 | CLL | |
825 | TAD [12 | |
826 | SZL /IS CHAR A DIGIT? | |
827 | JMP JMPOUT /YES | |
828 | CHLOOP, ISZ CHTYPE /SKIP OVER ADDRESS | |
829 | CLA | |
830 | TAD I CHTYPE | |
831 | ISZ CHTYPE | |
832 | SMA /END OF LIST? | |
833 | JMP JMPOTX /MAYBE - JUMP WITH CODE IN AC | |
834 | TAD CHCH | |
835 | SZA CLA /DOES CHAR MATCH CHAR ON LIST? | |
836 | JMP CHLOOP /NO - KEEP LOOKING | |
837 | JMPOUT, DCA CHCH /ZERO CHAR | |
838 | TAD I CHTYPE | |
839 | DCA CHTYPE /SET UP TO RETURN INDIRECTLY | |
840 | JMPOTX, SZA CLA /IS THIS THE END? | |
841 | JMP CDIGIT /NO - GO CHECK FOR DIGIT | |
842 | JMP I CHTYPE /GO TO SPECIFIED ADDRESS | |
843 | ||
844 | ||
845 | SKPOUT, 0 /ROUTINE USED BY DATA-HANDLING SPECIFICATIONS | |
846 | JMS I [MORE /CHECK FOR REPEAT COUNT EXHAUSTED | |
847 | TAD RWFLAG | |
848 | CLL RAR | |
849 | SZA CLA /IF OUTPUT, | |
850 | ISZ SKPOUT /SKIP RETURN | |
851 | SZL CLA /IF END OF I/O LIST, | |
852 | JMS I [ENDREC /DON'T RETURN AT ALL - GO AWAY | |
853 | JMP I SKPOUT | |
854 | \f/A FORMAT PROCESSOR | |
855 | ||
856 | AINPUT, TAD (4040 | |
857 | DCA ACH | |
858 | TAD (4040 | |
859 | DCA ACL /INITIALIZE LOW-ORDER WORDS TO BLANKS | |
860 | AINPTL, JMS GADR | |
861 | SZL /LEFT OR RIGHT? | |
862 | JMP AINPTR /RIGHT | |
863 | JMS I [FMTIN | |
864 | STL RTL /INPUT CHAR GOES IN HIGH-ORDER | |
865 | RTL /WITH BLANK IN LOW-ORDER | |
866 | RTL | |
867 | JMP AINPTC | |
868 | AINPTR, JMS I [FMTIN | |
869 | TAD I FMTGLR /COMBINE INPUT CHAR AND OLD LEFT HALF | |
870 | TAD [-40 /DELETE PREVIOUS RIGHT-HALF SPACE | |
871 | AINPTC, DCA I FMTGLR /STORE WORD | |
872 | ISZ W | |
873 | JMP AINPTL /LOOP AROUND WIDTH | |
874 | ANXT, JMS I [GETLMN /GET NEXT ELEMENT | |
875 | AFMT, TAD D | |
876 | CIA | |
877 | DCA W /SAVE FIELD WODTH AS A COUNT | |
878 | JMS I [SKPOUT /CHECK FOR REPEAT COUNT OVFLO AND I/O DIR | |
879 | JMP AINPUT | |
880 | AOTPUT, JMS GADR /OUTPUT - GET ADDRESS OF BYTE | |
881 | TAD I FMTGLR | |
882 | JMS FMTGLR /GET BYTE | |
883 | JMS I [FMTOUT /PRINT IT | |
884 | ISZ W | |
885 | JMP AOTPUT /LOOP ON WIDTH | |
886 | JMP ANXT | |
887 | ||
888 | FMTGLR, 0 /SUBR TO EXTRACT A CHAR FROM A WORD | |
889 | SZL | |
890 | JMP .+4 /RIGHT HALF | |
891 | RTR | |
892 | RTR | |
893 | RTR /LEFT HALF - ROTATE INTO RIGHT HALF | |
894 | AND [77 | |
895 | JMP I FMTGLR | |
896 | ||
897 | GADR, 0 /BYTE ADDRESS ROUTINE FOR A FORMAT PROCESSOR | |
898 | TAD D | |
899 | TAD W /FORM BYTE OFFSET IN THE RANGE 0 THRU D-1 | |
900 | CLL RAR | |
901 | TAD (ACX | |
902 | DCA FMTGLR | |
903 | JMP I GADR /LEAVE WITH L/R FLAG IN LINK | |
904 | \f/"STOP" ROUTINE - TERMINATES JOB | |
905 | ||
906 | CALXIT, TAD EXDVNO | |
907 | CIA | |
908 | DCA ACI /GO THROUGH THE FORTRAN UNIT NUMBERS. | |
909 | DCA I (ENDFLS /*K* TURN "ENDFL" INTO A SUBROUTINE | |
910 | JMS I (LDDSRN /IF WE FIND A UNIT WHICH IS BEING USED | |
911 | SNA CLA /AND HAS NOT BEEN ENDFILED, | |
912 | JMP XITISZ /WE WILL DUMP THE CURRENT BUFFER (IF IT | |
913 | CLA IAC /IS A FORMATTED OUTPUT FILE) AND | |
914 | AND FFLAGS /END-FILE IT | |
915 | SNA CLA | |
916 | JMS I (ENDFL | |
917 | XITISZ, ISZ EXDVNO | |
918 | JMP CALXIT | |
919 | LPTTWT, TAD I LPGET /WAIT FOR LINE PRINTER AND TELETYPE TO | |
920 | TAD TOCHR /GO QUIET. | |
921 | SZA CLA | |
922 | JMP LPTTWT | |
923 | ISZ CLNADR /SET UP TO CLOSE OUTPUT FILES | |
924 | PDPXIT, IOF /ENTER HERE FROM 7605 | |
925 | CDF 0 /TO PROTECT CLODS WITH PDP 8/E'S | |
926 | JMS I (7607 | |
927 | 0210 | |
928 | 7400 /READ IN CLEANUP ROUTINE | |
929 | 37 /AND OS/8 PAGE 17600 | |
930 | JMP .-5 /AYEEEE!! SYSTEM DEVICE GONZO! | |
931 | CDF CIF 10 | |
932 | JMP I CLNADR /CLOSE TENTATIVE FILES AND EXIT | |
933 | CLNADR, CLNUP | |
934 | EXDVNO, -11 | |
935 | ||
936 | ARGLD, 0 /ROUTINE TO GET VALUE OF AN ARG | |
937 | JMS I [FETPC | |
938 | AND [7 /THROW AWAY OPCODE (JA) | |
939 | TAD FLDTM2 | |
940 | DCA FGPBF | |
941 | JMS I [FETPC /CONSTRUCT AN FPP INSTRUCTION | |
942 | DCA BIOPTR | |
943 | JMS I [FPGO | |
944 | FGPBF | |
945 | JMP I ARGLD | |
946 | ||
947 | FLDTM2, FLDA+LONG | |
948 | FTEMP2 | |
949 | FEXIT | |
950 | PAGE | |
951 | \f/SUBROUTINE TO OPEN A UNIT FOR I/O | |
952 | ||
953 | RWINIT, 0 | |
954 | DCA RWFLAG /DIRECTION IN AC ON ENTRY | |
955 | AC7776 | |
956 | AND I RWINIT /IF CALLED FROM BACKSPACE, REWIND OR ENDFILE | |
957 | SZA CLA /UNIT NUMBER IS IN FAC | |
958 | JMS I [ARGLD /OTHERWISE, GET UNIT NUMBER | |
959 | JMS I [FFIX | |
960 | TAD ACI | |
961 | CLL CMA | |
962 | TAD [12 | |
963 | SZL CLA /CHECK DEVICE NUMBER IN RANGE 0-9 | |
964 | JMS LDDSRN /LOAD DSRN ENTRY INTO PAGE 0 | |
965 | SNA CLA /IS UNIT INITIALIZED? | |
966 | UNTERR, JMS I ERR /NO - ERROR | |
967 | TAD RWFLAG | |
968 | SPA /IF WE ARE WRITEING FOR THE FIRST TIME | |
969 | TAD FFLAGS /ON A UNIT WHICH WAS BEING READ, | |
970 | CMA RAL /WE MUST BUMP THE RELATIVE BLOCK NUMBER DOWN | |
971 | SNL SMA CLA /ONE BECAUSE OF A PHILOSOPHICAL DIFFERENCE | |
972 | JMS I (RD2WR /BETWEEN READ AND WRITE | |
973 | TAD I RWINIT | |
974 | TAD RWFLAG /OR THE I/O TYPE AND | |
975 | CMA | |
976 | AND FFLAGS /DIRECTION BITS INTO THE FLAG WORD | |
977 | TAD I RWINIT | |
978 | TAD RWFLAG | |
979 | DCA FFLAGS | |
980 | TAD FFLAGS | |
981 | CMA RTL | |
982 | SNL SMA CLA /IT IS ILLEGAL TO ACCESS A FILE IN | |
983 | JMP UNTERR /FORMATTED AND UNFORMATTED MODES | |
984 | ISZ RWINIT | |
985 | TAD ACI | |
986 | CLL RAL | |
987 | TAD ACI | |
988 | TAD (DATABL-4 | |
989 | DCA XR /STORE POINTER INTO DIRECT-ACCESS TABLE | |
990 | JMP I RWINIT | |
991 | \f/REWIND AND END FILE | |
992 | ||
993 | RWIND, JMS RWINIT /GET THE DSRN ENTRY | |
994 | 0 /DON'T PLAY WITH MODES | |
995 | AC2000 | |
996 | TAD FFLAGS | |
997 | SNA CLA /IF FORMATTED OUTPUT FILE AND NOT EOF'D | |
998 | JMS DMPBUF /DUMP LAST BUFFER AS A FAVOR | |
999 | ATLDMK, CLA IAC | |
1000 | AND FFLAGS /KILL ALL FLAG BITS | |
1001 | DCA FFLAGS /EXCEPT "END-FILED" BIT | |
1002 | TAD BADFLD | |
1003 | AND [7400 | |
1004 | DCA CHRPTR | |
1005 | AC7775 | |
1006 | DCA CHRCTR /INITIALIZE BUFFER POINTERS | |
1007 | DCA RELBLK /AND RELATIVE BLOCK # | |
1008 | JMP I [ENDIO /RESTORE DSRN AND EXIT | |
1009 | ||
1010 | ENDFL, JMS RWINIT /*K* USED AS A SUBROUTINE BY CALXIT | |
1011 | 1 /GET DSRN, SET "END FILE" FLAG | |
1012 | TAD FFLAGS /IF THE FILE IS UNFORMATTED, | |
1013 | CMA RAL /OR WAS NOT OUTPUT ONTO, | |
1014 | SNL SMA CLA /THEN ENDFILE DOES NOTHING. | |
1015 | JMS DMPBUF /ELSE DUMP THE FINAL BUFFER | |
1016 | AC3777 | |
1017 | AND FFLAGS /CLEAR WRITE BIT SO WE WILL NOT TRY | |
1018 | SETTOT, DCA FFLAGS /ANYTHING ON A SUBSEQUENT ENDFILE | |
1019 | TAD RELBLK /SET NEW LENGTH OF FILE IN CASE ITS TENTATIVE, | |
1020 | DCA TOTBLK /AND SO WE WON'T READ PAST EOF. | |
1021 | ENDIO, JMS INITMV /SET UP DSRN POINTERS | |
1022 | TAD I XR1 | |
1023 | DCA I XR /STORE BACK THE DSRN ENTRY | |
1024 | ISZ T /FOR THIS LOGICAL UNIT | |
1025 | JMP .-3 | |
1026 | DCA VEOFSW /CLEAR EOFSW AT END OF EVERY READ | |
1027 | ENDFLS, JMP I [RETURN /RETURN TO THE CALLING PROGRAM | |
1028 | JMP I ENDFL /*K* OR RETURN TO CALXIT | |
1029 | ||
1030 | INITMV, 0 /ROUTINE TO SET UP STUFF | |
1031 | ICDF0, CDF 0 | |
1032 | TAD LOGUNT | |
1033 | DCA XR | |
1034 | TAD (HAND-1 | |
1035 | DCA XR1 | |
1036 | TAD (-11 | |
1037 | DCA T | |
1038 | JMP I INITMV | |
1039 | \f/ROUTINE TO DUMP CURRENT OUTPUT BUFFER WITH ^Z AT THE END | |
1040 | ||
1041 | DMPBUF, 0 | |
1042 | ISZ EOLSW /FORCE COLUMN 1 SWITCH OFF | |
1043 | TAD (7712 /OUTPUT A LINE FEED | |
1044 | JMS I [FMTOUT | |
1045 | TAD HAND /IF THE FILE IS BEING OUTPUT VIA | |
1046 | SMA CLA /AN OS/8 HANDLER, | |
1047 | JMP CLREOL /WE MUST TERMINATE THE BUFFER PROPERLY. | |
1048 | TAD (32 | |
1049 | CTZLP, TAD Z7700 /OUTPUT A ^Z AND FILL BUFFER WITH ZEROES. | |
1050 | JMS I [FMTOUT /NEGATIVE NUMBERS TURN INTO CONTROL CHARS | |
1051 | TAD CHRPTR | |
1052 | AND [377 | |
1053 | TAD CHRCTR /FILL THE BUFFER UNTIL CHRPTR POINTS TO | |
1054 | IAC /A BLOCK BOUNDARY AND CHRCTR = -3 | |
1055 | Z7700, SMA CLA /WE ARE THEN AT BUFFER-END | |
1056 | JMP CTZLP | |
1057 | CLREOL, DCA EOLSW /RESET TO BEGINNING OF LINE | |
1058 | JMP I DMPBUF /RETURN | |
1059 | ||
1060 | /ROUTINE TO MOVE THE PROPER DSRN ENTRY INTO PAGE 0 | |
1061 | ||
1062 | LDDSRN, 0 | |
1063 | TAD ACI / READ/WRITE INIT SINGS THIS SONG, | |
1064 | CLL RTL / (DOO DAH, DOO DAH,) | |
1065 | RAL / DSRN ENTRIES 9 WORDS LONG | |
1066 | TAD ACI / (OH, DEE DOO DAH DAY). | |
1067 | ||
1068 | SNA /DEVICE NUMBER 0 IS SPECIAL - | |
1069 | TAD (PTTY+11-DSRN /IT'S ALWAYS THE TELETYPE | |
1070 | TAD (DSRN-12 | |
1071 | DCA LOGUNT | |
1072 | JMS INITMV /SET UP FOR MOVE | |
1073 | TAD I XR | |
1074 | DCA I XR1 /PUT DSRN ENTRY IN PAGE 0 | |
1075 | ISZ T | |
1076 | JMP .-3 | |
1077 | TAD BADFLD | |
1078 | AND [70 | |
1079 | TAD ICDF0 | |
1080 | DCA BUFCDF /SAVE BUFFER FIELD AS A CDF | |
1081 | TAD HAND | |
1082 | JMP I LDDSRN | |
1083 | PAGE | |
1084 | \f/BACKSPACE ROUTINE - WORKS ON BINARY OR ASCII FILES | |
1085 | ||
1086 | BKSPC, JMS I [RWINIT | |
1087 | 0 /GET THE DSRN ENTRY WITHOUT ALTERING MODE | |
1088 | TAD HAND | |
1089 | SMA CLA | |
1090 | JMP I [UNTERR /UNIT MUST BE BLOCK ORIENTED | |
1091 | AC2000 | |
1092 | AND FFLAGS | |
1093 | SZA CLA /IS FILE FORMATTED? | |
1094 | JMP BKASCI /YES - PAIN IN NECK | |
1095 | JMS BMPBLK /UNFORMATTED FILE - REREAD LAST BLOCK | |
1096 | TAD CHRPTR | |
1097 | TAD [377 | |
1098 | DCA T | |
1099 | JMS BUFFLD /SET DATA FIELD TO FIELD OF BUFFER | |
1100 | TAD I T /LOOK AT LAST WORD IN BUFFER | |
1101 | CIA /REGARD IT AS THE NUMBER OF BLOCKS/RECORD | |
1102 | TAD RELBLK | |
1103 | DCA RELBLK /RELBLK POINTS TO FIRST BLOCK OF PREV. REC | |
1104 | JMP I [ENDIO | |
1105 | ||
1106 | BMPBLK, 0 /SUBR TO BUMP BLOCK # BACK AND READ | |
1107 | CMA CLL /AC MAY NOT BE 0 ON ENTRY | |
1108 | TAD RELBLK | |
1109 | DCA RELBLK /BUMP BLOCK BACK | |
1110 | SNL | |
1111 | JMP I (ATLDMK /BACKSPACED TOO FAR - CALL IT QUITS | |
1112 | DCA CHRPTR /ZERO CHRPTR TO FORCE A READ FROM MASSIO | |
1113 | JMS I [MASSIO /READ A BLOCK | |
1114 | JMP I BMPBLK | |
1115 | ||
1116 | /**** NULL JOB GOES HERE FOR LACK OF A BETTER PLACE **** | |
1117 | ||
1118 | NULLJB, TAD N2525 | |
1119 | NULLLP, ISZ N2525 /PUT THE FAMOUS "POLY BASIC PATTERN" | |
1120 | JMP NULLLP /IN THE AC LIGHTS | |
1121 | ISZ NUMISZ | |
1122 | JMP NULLLP | |
1123 | CML CMA RAR | |
1124 | DCA N2525 | |
1125 | TAD [-4 | |
1126 | DCA NUMISZ | |
1127 | JMP I (VBACKG /GOT SOMETHING MORE USEFUL TO DO? | |
1128 | N2525, 2525 | |
1129 | NUMISZ, -4 | |
1130 | \f/BACKSPACE FOR FORMATTED FILES | |
1131 | ||
1132 | BKLORD, TAD I CHRPTR | |
1133 | ISZ CHRPTR | |
1134 | NOP | |
1135 | AND [177 /GET 7 BITS | |
1136 | TAD (-15 /COMPARE WITH C.R. - SINCE WE SKIPPED | |
1137 | SNA CLA /THE FIRST ONE THIS WILL BELONG TO THE PREVIOUS | |
1138 | JMP I [ENDIO /LINE AND WE WILL BE DONE (HAH!) | |
1139 | BKASCI, JMS I (MASBMP /A COMPLICATED MESS - FIRST BUMP THE | |
1140 | SKP /CHARACTER POINTER BACK TWO PLACES | |
1141 | JMP BKGTCH /AND THEN FETCH A CHARACTER. THIS WILL IGNORE | |
1142 | TAD BADFLD /THE LAST CHAR READ/WRITTEN (WHICH SHOULD | |
1143 | AND [7400 /BE A CARRIAGE RETURN). | |
1144 | CIA | |
1145 | TAD CHRPTR | |
1146 | CLL RAR | |
1147 | SZA CLA /TEST WHETHER WE HAVE TO READ AN OLD BUFFER | |
1148 | JMP BKNORD /NO | |
1149 | TAD CHRCTR /SAVE POSITION IN CURRENT DOUBLEWORD | |
1150 | DCA GETCH3 | |
1151 | DCA CHRPTR | |
1152 | AC4000 /IF WE ARE BACKSPACING AN OUTPUT FILE, | |
1153 | TAD FFLAGS /WE MUST SAVE THE INFORMATION IN THE | |
1154 | SPA /CURRENT BUFFER BY WRITING IT OUT. | |
1155 | JMP .+4 | |
1156 | DCA FFLAGS /ALSO CHANGE THE UNIT TO AN INPUT FILE | |
1157 | AC4000 /(RWINIT TAKES CARE OF SWITCHING BACK TO OUTPUT) | |
1158 | JMS I [MASSIO | |
1159 | CLA IAC /WE DON'T WANT THE LAST BLOCK READ/WRITTEN, | |
1160 | JMS BMPBLK /THAT'S IN CORE - WE WANT THE ONE | |
1161 | TAD GETCH3 /BEFORE THAT. | |
1162 | DCA CHRCTR | |
1163 | TAD CHRCTR | |
1164 | TAD (401 | |
1165 | SKP /COMPUTE WORD POINTER FROM CHAR POINTER | |
1166 | BKNORD, STA | |
1167 | TAD CHRPTR | |
1168 | DCA CHRPTR /BUMP WD PTR BACK 1 | |
1169 | BKGTCH, JMS I (MASBMP /NOW GET A CHARACTER - THIS LOOKS A LOT | |
1170 | JMP BKLORD /LIKE THE INPUT ROUTINE | |
1171 | JMS GETCH3 | |
1172 | JMP BKLORD+1 | |
1173 | \fGETCH3, 0 /COMMON CODE BETWEEN BACKSPACE AND INPUT | |
1174 | TAD I CHRPTR | |
1175 | AND [7400 | |
1176 | DCA BMPBLK /HANDY TEMPORARY | |
1177 | ISZ CHRPTR | |
1178 | TAD I CHRPTR | |
1179 | AND [7400 | |
1180 | CLL RTR | |
1181 | RTR /COMBINE TWO 4-BIT QUANTITIES | |
1182 | TAD BMPBLK /INTO A CHARACTER | |
1183 | CLL RTR | |
1184 | RTR | |
1185 | JMP I GETCH3 | |
1186 | ||
1187 | DATABL, ZBLOCK 33 /DIRECT ACCESS TABLE | |
1188 | PAGE | |
1189 | \f/I,E,F,AND G FORMAT CONVERSIONS | |
1190 | ||
1191 | IFMT, TAD D | |
1192 | DCA W /SET WIDTH PROPERLY | |
1193 | DCA D /FOR SCALING PURPOSES | |
1194 | STA | |
1195 | DCA IFLG | |
1196 | JMP FFMT | |
1197 | ||
1198 | GFMT, STA | |
1199 | DCA GFLG /SET G AND E FLAGS | |
1200 | ||
1201 | EFMT, STA | |
1202 | DCA EFLG /SET E FLAG | |
1203 | JMP FFMT | |
1204 | ||
1205 | IGEF, JMS I [GETLMN /MAIN LOOP FOR CONVERSIONS - SKIPPED 1ST TIME | |
1206 | FFMT, TAD D | |
1207 | DCA OD /SAVE COUNT OF POST-D.P. DIGITS | |
1208 | TAD IFLG | |
1209 | SNA CLA /APPLY THE P-SCALE FACTOR | |
1210 | TAD PFACT /ONLY IF THE FORMAT IS NOT I | |
1211 | DCA PFACTX | |
1212 | DCA SCALE /DON'T LOOK FOR TROUBLE | |
1213 | JMS I [SKPOUT /CHECK IF MORE AND TEST DIRECTION | |
1214 | JMP I (IGEFIN /INPUT | |
1215 | STA | |
1216 | DCA I [FFNEG /USE NEGATE ROUTINE HEADER AS SIGN FLAG | |
1217 | TAD EFLG | |
1218 | CLL RAL | |
1219 | CLL RAL /0 IF NOT E, -4 IF E | |
1220 | TAD W /THIS PROVIDES FOR THE EXP. FIELD (IF E FMT) | |
1221 | DCA OW /OR THE 4 TRAILING SPACES (IF G FMT) | |
1222 | TAD ACH | |
1223 | SNA | |
1224 | JMP SKPSHT /AC IS ZERO - SKP A LOT OF SHT | |
1225 | SPA CLA | |
1226 | JMS I [FFNEG /AC<0 - NEGATE IT AND SET FLAG (CLEVER) | |
1227 | SCALUP, DCA SCALE | |
1228 | TAD ACX | |
1229 | SMA SZA CLA /AC<1.0? | |
1230 | JMP GT1 /NO | |
1231 | JMS I [FPGO /YES - MULTIPLY BY 10.0 | |
1232 | FMUL10 | |
1233 | STA | |
1234 | TAD SCALE /BUMP POWER OF TEN | |
1235 | JMP SCALUP | |
1236 | \f/I,G,E,F, OUTPUT CONVERSIONS - NUMBER IS NOW =>1.0 | |
1237 | ||
1238 | GT1, JMS I (SCALDN /NOW DECREASE IT TO THE INTERVAL [0,1) | |
1239 | JMS I [FPGO /SAVE IT AWAY | |
1240 | FSTTMP | |
1241 | TAD [7 | |
1242 | JMS OSCALE | |
1243 | JMS I [FPGO /USE IT TO ROUND THE NUMBER TO BE OUTPUT | |
1244 | FADTMP | |
1245 | JMS I (SCALDN /WE COULD HAVE ROUNDED FROM .999... TO 1.000... | |
1246 | SKPSHT, TAD GFLG /ENTER HERE IF NUM WAS 0 - SCALE=0 | |
1247 | SNA CLA | |
1248 | JMP NOTG /NOT G FORMAT | |
1249 | TAD SCALE /G FORMAT - TEST FOR OUT OF F FORMAT RANGE | |
1250 | TAD PFACTX | |
1251 | CIA CLL /F FORMAT RANGE IS [.1,10**(D VALUE)) | |
1252 | TAD OD | |
1253 | SNL | |
1254 | JMP USEE /IF OUT OF BOUNDS USE E FORMAT (FLAG IS SET) | |
1255 | DCA OD /REDUCE D VALUE BY SCALE FACTOR | |
1256 | DCA EFLG /TO RETAIN CORRECT # OF SIG. DIGITS | |
1257 | USEE, CLA | |
1258 | JMP NOTG | |
1259 | ||
1260 | /SET UP TO PRINT DIGITS | |
1261 | ||
1262 | ||
1263 | DIGCNT, 0 | |
1264 | TAD PFACTX /COMPUTE EXPONENT JUST IN CASE E FORMAT | |
1265 | CIA | |
1266 | TAD SCALE | |
1267 | DCA FMTNUM | |
1268 | TAD EFLG | |
1269 | SNA CLA /NOW COMPUTE THE NUMBER OF DIGITS BEFORE THE D.P. | |
1270 | TAD SCALE /TAKE SCALE FACTOR INTO ACCOUNT IF NOT E FORMAT | |
1271 | TAD PFACTX /TAKE P FACTOR INTO ACCOUNT IF NOT I OR F/G | |
1272 | DCA SCALE /STORE THE NUMBER OF DIGITS BEFORE THE D.P. | |
1273 | TAD I [FFNEG /INCREASE NUMBER OF LEADING BLANKS BY 1 | |
1274 | SPA CLA /IF THE NUMBER IS POSITIVE. THIS DEPENDS ON | |
1275 | ISZ OW /THIS LOCATION BEING BELOW 4000. | |
1276 | TAD SCALE /GET THE NUMBER OF PRE-D.P. DIGITS (AS NEGATIVE #) | |
1277 | SPA SNA | |
1278 | CLA IAC /IF NONE, PRINT A 0 SO COUNT AS 1 | |
1279 | TAD OD /REDUCE THE WIDTH BY THIS NUMBER | |
1280 | CMA | |
1281 | TAD OW /REDUCE IT AGAIN BY THE POST-D.P. DIGIT COUNT | |
1282 | CIA | |
1283 | TAD IFLG /AND AGAIN BY 1 FOR THE D.P. (IF NOT I FORMAT) | |
1284 | JMP I DIGCNT | |
1285 | OW, 0 | |
1286 | \f/I,G,E,F FORMAT - ROUTINE TO SCALE ROUNDING FACTOR | |
1287 | ||
1288 | OSCALE, 0 /SUBR TO SCALE .5 THE CORRECT # OF TIMES | |
1289 | DCA NPLCS /MAX IN AC ON ENTRY | |
1290 | DCA ACX | |
1291 | AC2000 /FORM A FLOATING 0.5 IN ORDER | |
1292 | DCA ACH /TO ROUND THE NUMBER BEFORE PRINTING. | |
1293 | DCA ACL | |
1294 | TAD EFLG /FIGURE OUT HOW TO SCALE IT - | |
1295 | SNA CLA /THE THEORY IS THAT IT SHOULD BE SCALED | |
1296 | TAD SCALE /DOWN BY THE NUMBER OF SIGNIFICANT | |
1297 | DCA T /PRINTING DIGITS. THIS CAN BE | |
1298 | TAD SCALE /EXPRESSED AS: | |
1299 | CIA CLL /(P FACTOR) * (NOT (G FMT PRINTING AS F)) | |
1300 | TAD OD / + (SCALE FACTOR) * (NOT E FMT) + (D VALUE). | |
1301 | SZL CLA /THE SCALE FACTOR IS < 0 FOR | |
1302 | TAD GFLG /NUMBERS < .1, WHICH REDUCES | |
1303 | SNA CLA /THE # OF SIG. DIGITS VIA LEADING ZEROS. | |
1304 | TAD PFACTX /IF THERE ARE < 0 SIG. DIGITS | |
1305 | TAD T /IT DOESN'T MATTER WHAT WE DO | |
1306 | TAD OD /SINCE THE NUMBER WILL PRINT AS | |
1307 | SMA /0.00000 ANYWAY. | |
1308 | CMA /IF THERE ARE >NPLCS SIG. PRINTING DIGITS | |
1309 | TAD NPLCS /THE ROUNDING GETS MEANINGLESS SO MAKE | |
1310 | SPA /THE EXCESS DIVISIONS DIVIDES BY 2 INSTEAD | |
1311 | DCA ACX / OF BY 10. THIS FUDGE WORKS QUITE WELL | |
1312 | CIA /FOR NUMBERS OF UP TO NPLCS+2 | |
1313 | TAD NPLCS /SIGNIFICANT DIGITS. | |
1314 | CIA | |
1315 | DCA T | |
1316 | JMP .+3 | |
1317 | FDIVLP, JMS I [FPGO /SCALE THE .5 DOWN THE CORRECT NUMBER OF TIMES | |
1318 | FDIV10 | |
1319 | ISZ T | |
1320 | JMP FDIVLP | |
1321 | JMP I OSCALE | |
1322 | NPLCS, 0 | |
1323 | ONE, 1;2000;0 | |
1324 | PAGE | |
1325 | \f/I,G,E,F OUTPUT CONVERSION - ACTUAL OUTPUT SECTION | |
1326 | ||
1327 | OUTNUM, SMA /CHECK FOR FIELD OVERFLOW | |
1328 | JMP ASTSK1 /YES - PRINT ******* | |
1329 | JMS OBLNKS /PRINT LEADING BLANKS - AC IS NOT 0! | |
1330 | /***IMPORTANT - OBLNKS CLEARS AC1 *** | |
1331 | AC7775 | |
1332 | ISZ I [FFNEG /IF SIGN IS NEGATIVE, | |
1333 | JMS DIGIT /OUTPUT A MINUS SIGN | |
1334 | CLA /OTHERWISE OUTPUT NOTHING | |
1335 | TAD ACX | |
1336 | SNA /ALIGN THE FAC MANTISSA INTO A DOUBLEWORD | |
1337 | JMS I [AL1 /FRACTION IN THE RANGE [.1,1) | |
1338 | IAC /THIS INVOLVES SHIFTING THE MANTISSA | |
1339 | CMA /RIGHT BY (-ACX-1) PLACES | |
1340 | SMA /WHERE A NEGATIVE NUMBER MEANS A LEFT SHIFT. | |
1341 | JMS I [ACSR | |
1342 | CLA | |
1343 | TAD ACL /NOW MOVE THE FAC DOWN A WORD SO THAT | |
1344 | DCA AC1 /WHEN WE MULTIPLY BY 10 THE OVERFLOW APPEARS | |
1345 | TAD ACH /IN THE HIGH-ORDER WORD | |
1346 | DCA ACL | |
1347 | TAD SCALE | |
1348 | SPA SNA /DO WE HAVE DIGITS TO THE LEFT OF THE D.P.? | |
1349 | JMP PRZERO /NO - PRINT A ZERO THERE | |
1350 | JMS DIGITS /YES - PRINT THEM | |
1351 | PRDCPT, TAD IFLG | |
1352 | SZA CLA | |
1353 | JMP I (IGEF /IF I FORMAT, WE'RE DONE NOW | |
1354 | AC7776 | |
1355 | JMS DIGIT /OTHERWISE PRINT DECIMAL POINT | |
1356 | TAD SCALE | |
1357 | SMA CLA /CHECK WHETHER WE NEED TO PRINT LEADING ZEROS | |
1358 | JMP NOLZRO /NO | |
1359 | TAD SCALE | |
1360 | DCA T | |
1361 | LZLOOP, STA CLL | |
1362 | TAD OD /BUMP D VALUE DOWN BY ONE | |
1363 | SNL /IF IT GOES NEGATIVE, | |
1364 | JMP NOMOAC /WE'VE RUN OUT OF FIELD WIDTH | |
1365 | DCA OD | |
1366 | JMS DIGIT /PRINT A ZERO | |
1367 | ISZ T /UNTIL THE COUNT (OR THE WIDTH) RUNS OUT | |
1368 | JMP LZLOOP | |
1369 | NOLZRO, TAD OD | |
1370 | SZA /IF THERE ARE ANY DIGITS YET TO BE PRINTED, | |
1371 | JMS DIGITS /PRINT THEM | |
1372 | \f/I,G,E,F OUTPUT CONVERSION - FINISH UP | |
1373 | ||
1374 | NOMOAC, CLA | |
1375 | TAD EFLG | |
1376 | SNA CLA /E FORMAT? | |
1377 | JMP CHKG /NO - CHECK FOR G FORMAT OUTPUT AS F | |
1378 | JMS EXPFLD | |
1379 | JMP I (IGEF | |
1380 | EXPFLD, 0 | |
1381 | TAD (5 | |
1382 | JMS I [FMTOUT /OUTPUT "E" | |
1383 | TAD FMTNUM /GET EXPONENT | |
1384 | CLL | |
1385 | SPA | |
1386 | CML CIA /SEPARATE INTO MAGNITUDE AND SIGN | |
1387 | DCA FMTNUM /SAVE MAGNITUDE | |
1388 | RTL | |
1389 | TAD (-5 /PRINT + OR - | |
1390 | JMS DIGIT | |
1391 | DCA T /INITIALIZE QUOTIENT OF DIVISION | |
1392 | DVELP, TAD FMTNUM /SUBTRACT 10 FROM EXPONENT | |
1393 | TAD [-12 | |
1394 | SPA /DID IT GO NEGATIVE? | |
1395 | JMP PRNTXP /YES - DONE | |
1396 | DCA FMTNUM /NO - STORE IT BACK | |
1397 | ISZ T /BUMP QUOTIENT | |
1398 | JMP DVELP /LOOP | |
1399 | PRNTXP, CLA | |
1400 | TAD T | |
1401 | TAD [-12 | |
1402 | SMA CLA | |
1403 | JMP ASTSK3 | |
1404 | TAD T | |
1405 | JMS DIGIT | |
1406 | TAD FMTNUM | |
1407 | JMS DIGIT /PRINT TWO DIGITS OF EXPONENT | |
1408 | JMP I EXPFLD | |
1409 | ||
1410 | CHKG, TAD GFLG | |
1411 | SNA /WAS IT G FORMAT? | |
1412 | JMP I (IGEF /NO - F OR I - DONE | |
1413 | DCA EFLG /RE-SET EFLG SINCE WE ZEROED IT BEFORE | |
1414 | TAD (-5 | |
1415 | JMS OBLNKS /OUTPUT 4 BLANKS | |
1416 | JMP I (IGEF /DONE WITH G FORMAT OUTPUT | |
1417 | ||
1418 | PRZERO, CLA /COME HERE IF NO SIG. DIGITS LEFT OF D.P. | |
1419 | JMS DIGIT /PRINT A ZERO | |
1420 | JMP PRDCPT /CONTINUE | |
1421 | ||
1422 | ASTSK3, AC0002 | |
1423 | JMP .+3 | |
1424 | ASTSK1, CLA /CLEAR THE AC | |
1425 | TAD W /GET THE FIELD WIDTH | |
1426 | JMS I [ASTRSK | |
1427 | JMP I (IGEF | |
1428 | \f/I,G,E,F OUTPUT CONVERSION - OUTPUT SUBROUTINES | |
1429 | ||
1430 | OBLNKS, 0 /SUBROUTINE TO PRINT A STRING OF BLANKS | |
1431 | DCA AC1 /MUST LEAVE AC1 ZERO ON EXIT SO THAT | |
1432 | JMP .+3 /FAC LEFT SHIFT WON'T SHIFT IN GARBAGE LATER ON | |
1433 | TAD [40 | |
1434 | JMS I [FMTOUT /OUTPUT A BLANK | |
1435 | ISZ AC1 | |
1436 | JMP .-3 /LOOP | |
1437 | JMP I OBLNKS /RETURN | |
1438 | ||
1439 | DIGITS, 0 /ROUTINE TO OUTPUT A STRING OF DECIMAL DIGITS | |
1440 | CIA | |
1441 | DCA T | |
1442 | DGLOOP, TAD AC1 | |
1443 | DCA AC2 /COPY AC INTO OPERAND FOR ADDITION LATER ON | |
1444 | TAD ACL | |
1445 | DCA OPL | |
1446 | DCA ACH /CLEAR "OVERFLOW WORD" | |
1447 | JMS I [AL1 | |
1448 | JMS I [AL1 /FAC=FAC*4 | |
1449 | DCA OPH | |
1450 | JMS I [OADD | |
1451 | JMS I [AL1 /FAC=ORIGINAL FAC*10 | |
1452 | TAD ACH /GET OVERFLOW | |
1453 | JMS DIGIT /PRINT IT | |
1454 | ISZ T /LOOP FOR SPECIFIED NUMBER | |
1455 | JMP DGLOOP | |
1456 | JMP I DIGITS /RETURN | |
1457 | ||
1458 | DIGIT, 0 /ROUTINE TO OUTPUT A DIGIT | |
1459 | TAD [60 | |
1460 | JMS I [FMTOUT /TRIVIAL, ISN'T IT? | |
1461 | JMP I DIGIT | |
1462 | PAGE | |
1463 | \f/I,G,E,F INPUT CONVERSION | |
1464 | ||
1465 | IGEFIN, STA /OD CONTAINS SCALING IF NO D.P. IN INPUT | |
1466 | DCA DPSW /INITIALIZE D.P. SW | |
1467 | STA | |
1468 | DCA INESW /DITTO EXPONENT SWITCH | |
1469 | TAD W | |
1470 | CMA | |
1471 | DCA FMTNUM /GET CHAR COUNT | |
1472 | INERSM, DCA ACX /RE-ENTER HERE AFTER SEEING "E" | |
1473 | DCA ACH /CLEAR FLOATING AC | |
1474 | DCA ACL | |
1475 | STA | |
1476 | JMP INMINS /SET SIGN PLUS | |
1477 | ||
1478 | INGCH, JMS I [FMTIN /GET A CHAR | |
1479 | JMS I [CHTYPE /CLASSIFY IT | |
1480 | 1234; IDIGIT /DIGIT | |
1481 | -56; INDCPT /. | |
1482 | -53; INLOOP /+ | |
1483 | -55; INMINS /- | |
1484 | -5; INE /E | |
1485 | -40; IBLDIG /BLANK - TREAT LIKE 0 IN FORTRAN STANDARD | |
1486 | -54; INEONM /, | |
1487 | 0 /OTHER - ERROR | |
1488 | INER, JMS I ERR | |
1489 | ||
1490 | INDCPT, DCA OD /ZERO COUNT OF DIGITS AFTER D.P. | |
1491 | ISZ DPSW /TEST AND SET D.P. SWITCH | |
1492 | JMP INER /WHOOPS - TWO D.P.S IN A NUMBER | |
1493 | JMP INLOOP /KEEP GOING | |
1494 | ||
1495 | IBLDIG, TAD EOLSW /SINCE THE BLEEPING STANDARD DOESN'T COVER | |
1496 | SZA CLA /TELETYPE I/O, WE KEEP SOME COOL BY IGNORING | |
1497 | JMP INLOOP /BLANKS CREATED BY EARLY LINE TERMINATION. | |
1498 | ||
1499 | IDIGIT, TAD CHCH | |
1500 | DCA DGT+1 /SAVE THE DIGIT | |
1501 | JMS I [FPGO /FORM 10*FAC + DIGIT IN FAC | |
1502 | ACMDGT | |
1503 | TAD DPSW | |
1504 | SNA CLA | |
1505 | ISZ OD /BUMP DIGIT COUNT IF D.P. SEEN | |
1506 | JMP INLOOP | |
1507 | \fINMINS, DCA I [FFNEG /SET SIGN NEGATIVE | |
1508 | ||
1509 | INLOOP, ISZ FMTNUM | |
1510 | JMP INGCH /LOOP UNTIL WIDTH EXHAUSTED | |
1511 | INEONM, ISZ I [FFNEG /CHECK IF SIGN NEGATIVE | |
1512 | JMS I [FFNEG /YES - NEGATE | |
1513 | ISZ INESW /SEE IF "E" SEEN | |
1514 | JMP FIXUPE /YES - WE HAVE EXPONENT, NOT NUMBER | |
1515 | TAD PFACTX /NO "E" SEEN - SCALE USING P FACTOR | |
1516 | ||
1517 | SCALIN, TAD OD /GET SCALING FACTOR | |
1518 | STL | |
1519 | SNA | |
1520 | JMP I (IGEF /NO SCALING NECESSARY | |
1521 | SMA | |
1522 | CIA CLL /AC CONTAINS MAGNITUDE, LINK CONTAINS SIGN | |
1523 | DCA OD | |
1524 | RTL | |
1525 | RAL /AC CONTAINS 0 IF DIVIDE, 4 IF MULTIPLY | |
1526 | TAD (FDIV10 | |
1527 | DCA IGEFOP | |
1528 | JMS I [FPGO /MULTIPLY OR DIVIDE BY 10.0 | |
1529 | IGEFOP, 0 | |
1530 | ISZ OD | |
1531 | JMP IGEFOP-1/MULT OR DIV APPROPRIATE NUMBER OF TIMES | |
1532 | JMP I (IGEF /RETURN FOR MORE | |
1533 | ||
1534 | INE, ISZ INESW /SEE IF THIS IS THE SECOND "E" | |
1535 | JMP INER /YES - ERROR | |
1536 | ISZ DPSW /FORCE DP SW ON (TO INHIBIT D.P. AFTER E) | |
1537 | TAD OD /USE SCALE FACTOR ONLY IF D.P. SEEN | |
1538 | DCA SCALE /SAVE SCALE FACTOR | |
1539 | ISZ I [FFNEG | |
1540 | JMS I [FFNEG /GET SIGN OF NUMBER CORRECT | |
1541 | JMS I [FPGO /SAVE IT TEMPORARILY | |
1542 | FSTTM2 | |
1543 | JMP INERSM /GO COLLECT EXPONENT | |
1544 | ||
1545 | FIXUPE, JMS I [FFIX | |
1546 | TAD ACI /GET EXPONENT | |
1547 | CIA | |
1548 | TAD SCALE /ADD IN EXPONENT TO D.P. SCALE FACTOR | |
1549 | DCA OD | |
1550 | JMS I [FPGO /GET NUMBER BACK IN FAC | |
1551 | FLDTM2 | |
1552 | JMP SCALIN | |
1553 | ||
1554 | DPSW, 0 | |
1555 | DGT, 13;0;0;0;0;0 | |
1556 | NOTG, JMS I (DIGCNT | |
1557 | DCA SCALDN | |
1558 | TAD IFLG | |
1559 | SNA CLA | |
1560 | JMP NOTI | |
1561 | TAD SCALE | |
1562 | TAD (-7 | |
1563 | SPA CLA | |
1564 | NOTI, TAD SCALDN | |
1565 | JMP I (OUTNUM | |
1566 | \fSCALDN, 0 /SUBROUTINE TO SCALE THE FAC LESS THAN 1.0 | |
1567 | TAD ACX | |
1568 | SPA SNA CLA /IS THE FAC => 1.0? | |
1569 | JMP I SCALDN /NO - WE'RE DONE | |
1570 | JMS I [FPGO /DIVIDE BY TEN | |
1571 | FDIV10 | |
1572 | ISZ SCALE /BUMP POWER OF TEN | |
1573 | 0 /BACKUP FOR WIDTH | |
1574 | JMP SCALDN+1 /LOOP | |
1575 | ||
1576 | ASTRSK, 0 | |
1577 | CIA | |
1578 | DCA T | |
1579 | TAD (52 | |
1580 | JMS I [FMTOUT | |
1581 | ISZ T | |
1582 | JMP .-3 | |
1583 | JMP I ASTRSK /GET NEXT ELEMENT | |
1584 | ||
1585 | INESW, 0 /"E SEEN" SWITCH ON INPUT | |
1586 | PAGE | |
1587 | \f/L AND X FORMATS , T FORMAT INPUT | |
1588 | ||
1589 | TFMTIN, JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY | |
1590 | CLA /BY FETCHING AND WASTING A CHARACTER | |
1591 | TAD (INBUFR | |
1592 | DCA INXR | |
1593 | DCA EOLSW /SET TO BEGINNING OF LINE | |
1594 | JMP XFMT | |
1595 | XFMTIN, JMS I [FMTIN | |
1596 | H7600, 7600 /WASTE AN INPUT CHAR | |
1597 | XFMT, JMS I [MORE /ANY MORE CHARS? | |
1598 | TAD RWFLAG /YES - IN OR OUT? | |
1599 | SMA CLA | |
1600 | JMP XFMTIN /IN | |
1601 | TPPLBL, TAD [40 /HERE WITH AC=13 TO OVERPRINT ON T OUTPUT | |
1602 | JMS I [FMTOUT /OUT | |
1603 | JMP XFMT | |
1604 | ||
1605 | LINGCH, JMS I [FMTIN | |
1606 | JMS I [CHTYPE /GET AND CLASSIFY CHARACTER | |
1607 | -40; LINLP /BLANK | |
1608 | -24; LINTRU /T | |
1609 | -6; LINFLS /F | |
1610 | 0 /OTHER - ERROR | |
1611 | JMP I (INER | |
1612 | ||
1613 | LINTRU, TAD (4001 | |
1614 | LINFLS, CLL RAR /PUT EITHER 0.0 OR 1.0 IN THE FAC | |
1615 | DCA ACH | |
1616 | DCA ACL | |
1617 | RAL | |
1618 | DCA ACX | |
1619 | LINLP, ISZ W | |
1620 | JMP LINGCH /LOOP ON FIELD WIDTH | |
1621 | ||
1622 | LNXT, JMS I [GETLMN /GET NEXT ELEMENT FOR I/O | |
1623 | LFMT, TAD D | |
1624 | CMA | |
1625 | DCA W /SAVE WIDTH AS A COUNT | |
1626 | JMS I [SKPOUT /IN OR OUT? | |
1627 | JMP LINFLS /IN | |
1628 | CLA IAC | |
1629 | TAD W | |
1630 | JMS I (OBLNKS /OUTPUT W-1 BLANKS | |
1631 | TAD ACH | |
1632 | SZA CLA | |
1633 | TAD (16 | |
1634 | TAD (6 /NON-ZERO IS TRUE, ZERO FALSE | |
1635 | JMS I [FMTOUT /OUTPUT T OR F | |
1636 | JMP LNXT /NEXT VICTIM | |
1637 | \f/T FORMAT OUTPUT AND RANDOM SUBROUTINES | |
1638 | ||
1639 | TFMT, TAD D | |
1640 | CIA | |
1641 | DCA N /USE N TO FAKE OUT "X" FMT ROUTINE | |
1642 | TAD RWFLAG | |
1643 | SMA CLA | |
1644 | JMP TFMTIN /INPUT | |
1645 | TAD N | |
1646 | TAD EOLSW /COMPARE DESIRED POSITION WITH CURRENT ONE | |
1647 | SPA | |
1648 | JMP TPBLNK /AFTER - SPACE TO IT | |
1649 | JMS EOLINE /OUTPUT CR AND ZERO EOLSW | |
1650 | JMS I [MORE /KLUDGE FOR "T1" FORMAT | |
1651 | TAD (13 /FAKE X FORMAT INTO PRINTING | |
1652 | JMP TPPLBL /A + AND (N-1) SPACES | |
1653 | TPBLNK, DCA N /SAVE DIFFERENCE BETWEEN POSITIONS | |
1654 | JMP XFMT /GO SPACE OUT | |
1655 | ||
1656 | EOLINE, 0 /SUBROUTINE TO TERMINATE I/O LINE | |
1657 | TAD RWFLAG /CAUTION - AC LO-ORDER BITS MAY NOT BE 0 | |
1658 | SPA CLA /INPUT OR OUTPUT? | |
1659 | JMP EOOUTL /OUTPUT | |
1660 | JMS I [FMTIN /FORCE INPUT BUFFER NON-EMPTY | |
1661 | CLA | |
1662 | TAD (INBUFR-1 | |
1663 | DCA INXR /SET XR TO NEGATIVE WORD AT THE | |
1664 | JMP .+3 /BEGINNING OF THE INPUT BUFFER | |
1665 | EOOUTL, TAD (7715 | |
1666 | JMS I [FMTOUT /OUTPUT A CARRIAGE RETURN | |
1667 | DCA EOLSW /CLEAR EOLSW FOR INPUT AND OUTPUT | |
1668 | JMP I EOLINE | |
1669 | \f/ROUTINE TO MOVE A HANDLER INTO FIELD 0 | |
1670 | ||
1671 | GETHND, 0 /HANDLER CODE WORD IN AC ON ENTRY | |
1672 | DCA HCW /SAVE HANDLER CODE WORD | |
1673 | TAD [7774 | |
1674 | AND HCW /KNOCK OUT ION AND FORMS CTL BITS | |
1675 | CIA | |
1676 | SZA /IF HANDLER IS NOT RESIDENT, | |
1677 | TAD HKEY /SEE IF THE HANDLER IS ALREADY | |
1678 | SNA CLA /IN THE HANDLER AREA IN FIELD 0 | |
1679 | JMP HINF0 /YES | |
1680 | TAD HCW /NO - PUT IT THERE | |
1681 | AND [70 | |
1682 | TAD HCDF0 | |
1683 | DCA HNDCDF /GET CDF TO FIELD IN WHICH HANDLER RESIDES | |
1684 | TAD HCW | |
1685 | AND H7600 | |
1686 | TAD (-1 /GET POINTER TO HANDLER ADDRESS | |
1687 | DCA XR1 /IN THAT FIELD | |
1688 | TAD (HPLACE-1 | |
1689 | DCA XR /ALSO TO HANDLER AREA IN FIELD 0 | |
1690 | TAD [7400 /SET UP COUNT OF 7400 | |
1691 | DCA HKEY /INDEPENDENT OF HANDLER SIZE | |
1692 | HNDCDF, HLT | |
1693 | TAD I XR1 | |
1694 | HCDF0, CDF 0 | |
1695 | DCA I XR /MOVE HANDLER INTO HANDLER AREA | |
1696 | ISZ HKEY | |
1697 | JMP HNDCDF | |
1698 | TAD [7774 | |
1699 | AND HCW | |
1700 | DCA HKEY /SET NEW KEY CODE WORD | |
1701 | HINF0, CLA IAC | |
1702 | AND HCW | |
1703 | SNA CLA /INTERRUPTS ALLOWED? | |
1704 | YHIOF, IOF /NO - TOO BAD | |
1705 | ISZ CTCINH /INHIBIT ^C DURING HANDLER CALL | |
1706 | JMP I GETHND | |
1707 | HKEY, 0 | |
1708 | HCW, 0 | |
1709 | PAGE | |
1710 | \f/CHARACTER INPUT ROUTINE - LINE AT A TIME | |
1711 | ||
1712 | FMTIN, 0 | |
1713 | TAD EOLSW | |
1714 | SNA /END OF LINE ALREADY FOUND? | |
1715 | TAD I INXR /NO - GET CHAR FROM LINE BUFFER | |
1716 | SPA /TIME TO READ A NEW LINE? | |
1717 | JMP READLN /YES | |
1718 | SNA /END OF LINE? | |
1719 | JMP INEOL /YES - SET INDICATOR | |
1720 | AND [77 /CONVERT TO SIXBIT | |
1721 | JMP I FMTIN /RETURN WITH IT | |
1722 | INEOL, TAD [40 | |
1723 | UNPKLN, DCA EOLSW /SET EOL INDICATOR TO A BLANK | |
1724 | JMP FMTIN+1 /AND RETURN BLANKS FROM HERE ON IN | |
1725 | READLN, DCA EOLSW /USE EOLSW AS A COUNT SO IT WINDS UP 0 | |
1726 | TAD HAND | |
1727 | TAD (-TTY | |
1728 | SNA CLA /IS IT TELETYPE INPUT? | |
1729 | STA /YES - SET TTY FLAG | |
1730 | DCA TTYFLG | |
1731 | JMS ECHO | |
1732 | TTYLF, 12 /ECHO LF IF TTY INPUT | |
1733 | TAD [12 /TTYLF IS ZEROED BY ABORTO | |
1734 | DCA TTYLF | |
1735 | ||
1736 | READLP, CLA | |
1737 | TAD HAND | |
1738 | SPA CLA /CHARACTER ORIENTED DEVICE? | |
1739 | JMP MASSIN /NO - UNPACK CHAR FROM BUFFER | |
1740 | JMS I HAND /GET A CHARACTER | |
1741 | GOTCHR, AND [177 /STRIP OFF PARITY | |
1742 | JMS I [CHTYPE /CLASSIFY IT | |
1743 | -15; INCRET /CARRIAGE RETURN | |
1744 | -177; RUBOUT /RUBOUT | |
1745 | -11; INTAB /TAB | |
1746 | -25; CTRLU /^U | |
1747 | -32; INEOF /^Z | |
1748 | 0 /ANYTHING ELSE | |
1749 | TAD CHCH | |
1750 | TAD [-40 | |
1751 | SMA /IF CHARACTER IS >37, | |
1752 | JMS INPUTC /STORE IT AND ECHO IT IF TTY | |
1753 | JMP READLP | |
1754 | \f/CHARACTER INPUT ROUTINE - SPECIAL CHARACTER HANDLERS | |
1755 | ||
1756 | INTAB, JMS INPUTC /TAB - INSERT (AND ECHO) BLANKS | |
1757 | TAD INXR | |
1758 | AND [7 | |
1759 | SZA CLA /UNTIL A COLUMN MULTIPLE OF 8 IS REACHED | |
1760 | JMP INTAB | |
1761 | JMP READLP | |
1762 | ||
1763 | RUBOUT, TAD EOLSW | |
1764 | CIA | |
1765 | TAD I (INBUFR /IGNORE RUBOUTS IF LINE EMPTY | |
1766 | AND TTYFLG | |
1767 | SNA CLA | |
1768 | JMP READLP /OR IF NON-TTY INPUT | |
1769 | JMS ECHO | |
1770 | 134 /ECHO A BACKSLASH | |
1771 | IBAKUP, STA | |
1772 | TAD INXR | |
1773 | DCA INXR /BACK UP LINE POINTER | |
1774 | STA | |
1775 | TAD EOLSW | |
1776 | DCA EOLSW /AND CHAR COUNTER | |
1777 | JMP READLP | |
1778 | ||
1779 | INEOF, TAD VEOFSW /CHECK SWITCH SET BY "CHKEOF" LIBRARY ROUTINE | |
1780 | SNA /WAS HE EXPECTING AN EOF? | |
1781 | EOFERR, JMS I ERR /NO | |
1782 | JMS I MCDF | |
1783 | DCA .+1 | |
1784 | HLT /CDF TO FIELD OF INDICATOR VARIABLE | |
1785 | AC2000 | |
1786 | DCA I VEOFSW+1 /SET VARIABLE TO .5 | |
1787 | CDF 0 /FALL INTO CARRIAGE RETURN CODE | |
1788 | ||
1789 | INCRET, DCA I INXR /CARRIAGE RETURN - ZERO OUT REST OF LINE | |
1790 | SKP | |
1791 | CTRLU, STA /SNEAKY, SNEAKY! | |
1792 | TAD (INBUFR | |
1793 | DCA INXR /RESET XR TO FETCH LINE CHARS | |
1794 | JMS ECHO | |
1795 | 15 /ECHO THE C.R. | |
1796 | JMP UNPKLN /BACK TO FETCH FIRST CHAR | |
1797 | ||
1798 | INPUTC, 0 /ROUTINE TO STORE AND ECHO A CHAR | |
1799 | TAD [40 | |
1800 | DCA INTMP | |
1801 | JMS ECHO | |
1802 | INTMP, 0 /ECHO CHAR IF TTY INPUT | |
1803 | TAD INTMP | |
1804 | DCA I INXR /STORE CHAR IN LINE BUFFER | |
1805 | ISZ EOLSW | |
1806 | JMP I INPUTC /RETURN IF NO OVERFLOW | |
1807 | JMP IBAKUP /IGNORE CHAR IF OVERFLOW | |
1808 | \fECHO, 0 /ROUTINE TO ECHO CHAR IF TTY INPUT | |
1809 | TAD I ECHO /GET CHAR | |
1810 | AND TTYFLG | |
1811 | SZA /SHOULD WE ECHO? | |
1812 | JMS I HAND /YES | |
1813 | JMP I ECHO /RETURN TO CHARACTER - ITS SMALL | |
1814 | TTYFLG, 0 | |
1815 | ||
1816 | /CHARACTER INPUT ROUTINE - MASS STORAGE SECTION | |
1817 | ||
1818 | MASSIN, JMS MASBMP /GET BUFFER FIELD AND CHAR NUMBER | |
1819 | JMP INLORD /CHAR 1 OR 2 - STRAIGHTFORWARD | |
1820 | JMS I (GETCH3 /USE COMMON SUBROUTINE | |
1821 | JMP MASICM /GO TO COMMON CODE | |
1822 | ||
1823 | INLORD, JMS I [MASSIO /CHECK IF WE SHOULD READ IN A BUFFERLOAD | |
1824 | JMS BUFFLD /SET FIELD OF BUFFER | |
1825 | TAD I CHRPTR | |
1826 | MASICM, ISZ CHRPTR /GET THE CHAR (IN LOW 8 BITS) AND BUMP PTR | |
1827 | NOP /WATCH END OF FIELD FUNNYBUSINESS! | |
1828 | CDF 0 /RESET DATA FIELD | |
1829 | JMP GOTCHR /GO EXTRACT SEVEN BIT CHARACTER | |
1830 | ||
1831 | MASBMP, 0 | |
1832 | JMS BUFFLD /SET TO BUFFER'S DATA FIELD | |
1833 | ISZ CHRCTR /BUMP CHAR COUNTER | |
1834 | JMP I MASBMP /CHAR 1 OR 2 - NO SWEAT | |
1835 | AC7775 | |
1836 | DCA CHRCTR /CHAR 3 - RESET CHAR CTR | |
1837 | AC7776 | |
1838 | TAD CHRPTR /BUMP BACK CHAR PTR | |
1839 | DCA CHRPTR | |
1840 | ISZ MASBMP | |
1841 | JMP I MASBMP /SKIP RETURN | |
1842 | PAGE | |
1843 | \f/CHARACTER OUTPUT ROUTINE | |
1844 | ||
1845 | FMTOUT, 0 | |
1846 | TAD [40 /FIRST CONVERT SIXBIT TO ASCII | |
1847 | SMA /CTL CHARS COME IN NEGATIVE | |
1848 | AND [77 | |
1849 | TAD (240 | |
1850 | DCA OCHAR /SAVE ASCII CHAR (WITHOUT PARITY BIT) | |
1851 | TAD EOLSW | |
1852 | SZA CLA | |
1853 | JMP NOT1ST /FIRST CHAR IS DECODED FOR FORMS CONTROL | |
1854 | AC0002 /CHECK TO SEE IF THIS UNIT | |
1855 | AND HCODEW /SHOULD RECEIVE FORMS CONTROL | |
1856 | SZA CLA | |
1857 | JMP LFPLCH /NO - JUST PRINT A LINE FEED AND THE CHAR | |
1858 | TAD OCHAR | |
1859 | JMS I [CHTYPE /CLASSIFY CONTROL CHAR | |
1860 | -261; OUTFFX /1 - TOP OF FORM | |
1861 | -260; OUT2LF /0 - DOUBLE SPACE | |
1862 | -253; NOLF /+ - OVERPRINT | |
1863 | 0 /ANYTHING ELSE - SINGLE SPACE | |
1864 | JMP OUTLF | |
1865 | ||
1866 | OUTFFX, TAD HAND | |
1867 | TAD (-TTY /IF HANDLER IS TTY OUTPUT TWO LINE FEEDS | |
1868 | SZA CLA /INSTEAD OF A FORM FEED | |
1869 | JMP OUTFF | |
1870 | OUT2LF, TAD [12 | |
1871 | DCA OCHAR /SET 2ND CHAR TO LINE FEED | |
1872 | LFPLCH, STA | |
1873 | DCA EOLSW /SET SWITCH FOR 2ND CHAR | |
1874 | TAD OCHAR | |
1875 | DCA CHCH /SAVE CHARACTER AWAY | |
1876 | OUTLF, AC7776 | |
1877 | OUTFF, TAD F214 /SUBSTITUTE THE APPROPRIATE FORM CONTROL | |
1878 | DCA OCHAR /FOR THE CHARACTER | |
1879 | NOT1ST, TAD HAND | |
1880 | SPA CLA /CHARACTER ORIENTED DEVICE? | |
1881 | JMP MASOUT /NO - PACK CHAR INTO BUFFER | |
1882 | TAD OCHAR | |
1883 | JMS I HAND /OUTPUT CHAR | |
1884 | NOLF, ISZ EOLSW /BUMP CHAR CTR | |
1885 | JMP I FMTOUT /NO - RETURN | |
1886 | TAD CHCH /AHA - ANOTHER CHARACTER SHOULD BE OUTPUT | |
1887 | JMP OUTFF+1 /GO TO IT | |
1888 | \f/CHARACTER OUTPUT - MASS STORAGE OUTPUT | |
1889 | ||
1890 | MASOUT, JMS I (MASBMP /GET BUFFER FIELD AND CHAR NUMBER | |
1891 | JMP OULORD /CHAR 1 OR 2 - STRAIGHTFORWARD | |
1892 | JMS OSUBR /CHAR 3 - PACK FIRST HALFBYTE | |
1893 | JMS OSUBR /PACK SECOND HALFBYTE | |
1894 | AC4000 | |
1895 | JMS MASSIO /CHECK IF WE SHOULD DUMP THE BUFFER | |
1896 | MASOCM, CDF 0 | |
1897 | JMP NOLF /GO RETURN OR REENTER | |
1898 | ||
1899 | OULORD, TAD OCHAR | |
1900 | DCA I CHRPTR /STORE CHAR, ZAPPING HIGH-ORDER BITS | |
1901 | ISZ CHRPTR /BUMP CHAR PTR | |
1902 | F214, 214 /GUARD AGAINST OVFLO | |
1903 | JMP MASOCM /RETURN | |
1904 | ||
1905 | OSUBR, 0 /ROUTINE TO PACK A HALFBYTE | |
1906 | TAD OCHAR | |
1907 | CLL RTL | |
1908 | RTL /SHIFT CHAR 4 LEFT | |
1909 | DCA OCHAR | |
1910 | TAD I CHRPTR /CLEAR OUT ANY RESIDUE | |
1911 | AND [377 /FROM HIGH-ORDER OF BUFFER WORD | |
1912 | DCA I CHRPTR /IN CASE WE ARE WRITING AFTER A BACKSPACE. | |
1913 | TAD OCHAR | |
1914 | AND [7400 /GET 4 BITS | |
1915 | TAD I CHRPTR | |
1916 | DCA I CHRPTR /ADD INTO HIGH-ORDER OF BUFFER WORD | |
1917 | ISZ CHRPTR /BUMP POINTER | |
1918 | 200 /OVERFLOW! | |
1919 | JMP I OSUBR | |
1920 | ||
1921 | MASSIO, 0 /SUBROUTINE TO READ/WRITE BUFFER IF NECESSARY | |
1922 | CDF 0 | |
1923 | TAD BUFCDF /ADD BUFFER CDF TO R/W BIT IN AC | |
1924 | TAD (-6001 /TAKE AWAY CDF, LEAVE BIT 4 ON | |
1925 | DCA IOCTL /STORE I/O CONTROL WORD | |
1926 | TAD CHRPTR | |
1927 | AND [377 | |
1928 | SZA CLA /SEE IF POINTER IS AT BUFFER BOUNDARY | |
1929 | JMP I MASSIO /YES - RETURN DOING NOTHING | |
1930 | TAD RELBLK | |
1931 | TAD STBLK /STORE BLOCK # IN HANDLER CALL | |
1932 | DCA BLOCK | |
1933 | TAD BADFLD | |
1934 | AND [7400 | |
1935 | DCA BUFFER /STORE BUFFER ADDRESS IN HANDLER CALL | |
1936 | \f/CHARACTER OUTPUT - BUFFER I/O ROUTINE CONTINUED | |
1937 | ||
1938 | TAD TOTBLK | |
1939 | CIA CLL | |
1940 | TAD RELBLK | |
1941 | SZL CLA /CHECK FOR FILE OVERFLOW | |
1942 | IOVFLO, JMS I ERR /YES - ERROR | |
1943 | TAD HCODEW | |
1944 | JMS I (GETHND /GET HANDLER INTO FIELD 0 | |
1945 | JMS I HAND /CALL HANDLER | |
1946 | IOCTL, 0 | |
1947 | BUFFER, 0 | |
1948 | BLOCK, 0 | |
1949 | SMA CLA /HANDLER ERROR - ABORT | |
1950 | SKP /IF NOT EOF | |
1951 | IOERR, JMS I ERR | |
1952 | JMS I (RECOVR /CLEAR ANY FLAGS SET BY OS8 HANDLER | |
1953 | ISZ RELBLK /BUMP RELATIVE BLOCK NUMBER | |
1954 | TAD BUFFER | |
1955 | DCA CHRPTR /RESET CHAR PTR | |
1956 | JMP I MASSIO /RETURN | |
1957 | /FPP CODE FOR I/O CONVERSION | |
1958 | ||
1959 | FDIV10, FDIV+LONG | |
1960 | TEN | |
1961 | FEXIT | |
1962 | OCHAR, 0 /*** NEEDED FOR PADDING *** | |
1963 | FMUL10, FMUL+LONG /FMUL10 MUST BE AT FDIV10+4 | |
1964 | TEN | |
1965 | FEXIT | |
1966 | ||
1967 | FWTOBL, FSUB+LONG | |
1968 | ONE | |
1969 | FDIV+LONG | |
1970 | FLTG85 | |
1971 | FEXIT | |
1972 | PAGE | |
1973 | \f/UNFORMATTED (BINARY) INPUT-OUTPUT | |
1974 | ||
1975 | RWUNF, JMS I [RWINIT /"READ(N)" OR "WRITE(N)" | |
1976 | 1000 /"UNFORMATTED" BIT | |
1977 | TAD SZLCLA /ENABLE SEQUENCE CHECKING | |
1978 | UNFIO, DCA SEQCHK /*** SET SEQCHK TO "SZL CLA" OR "CLA" | |
1979 | DCA RECCTR /ENTER HERE FROM DIRECT ACCESS | |
1980 | TAD HAND | |
1981 | SMA CLA /CHECK FOR MASS-STORAGE HANDLER | |
1982 | JMP I [UNTERR /NO - ERROR | |
1983 | JMS I [GETLMN /GET FIRST VARIABLE | |
1984 | TAD RWFLAG | |
1985 | SPA CLA | |
1986 | RSETBP, TAD (125 /INITIALIZE COUNT TO -86 FOR WRITE, | |
1987 | CMA /-1 FOR READ | |
1988 | DCA CHRCTR | |
1989 | TAD BADFLD | |
1990 | AND [7400 | |
1991 | DCA BIOPTR /INITIALIZE BUFFER POINTER | |
1992 | TAD BADFLD | |
1993 | AND [70 | |
1994 | IAC | |
1995 | CLL RTR /AC BIT 0 NOW ON | |
1996 | TAD RWFLAG /AC BIT 0 CONTAINS COMP. OF R/W FLAG | |
1997 | CLL RAR /AC=(.NOT.RW)*2000+BUFFER FIELD | |
1998 | TAD (FSTA+LONG /AC=(FSTA OR FLDA) + BUFFLD | |
1999 | DCA FGPBF | |
2000 | JMP UIOVLP /SKIP FIRST VARIABLE FETCH/STORE | |
2001 | BFINCR, JMS I [FPGO | |
2002 | FGPBF /LOAD OR STORE A BUFFER ENTRY | |
2003 | ISZ BIOPTR | |
2004 | ISZ BIOPTR /INCREASE BUFFER POINTER | |
2005 | ISZ BIOPTR | |
2006 | JMS I [GETLMN /GET A VARIABLE FROM THE CALLING PROGRAM | |
2007 | UIOVLP, TAD RWFLAG | |
2008 | CLL RAR /LOWORDER BIT OF RWFLAG = END LIST FLAG | |
2009 | SZL CLA | |
2010 | JMP ENDUIO /NO MORE VARIABLES - TERMINATE | |
2011 | ISZ CHRCTR /BUMP COUNTER | |
2012 | JMP BFINCR /ROOM IN BUFFER - MOVE VARIABLE | |
2013 | JMS UDOIO /GET A NEW BUFFER | |
2014 | JMP RSETBP /RESET BUFFER POINTERS AND COUNTERS | |
2015 | ||
2016 | ENDUIO, TAD RWFLAG /COME HERE WHEN I/O LIST EXHAUSTED | |
2017 | SPA CLA /WRITE? | |
2018 | JMS UDOIO /YES - WRITE OUT THE LAST BUFFER | |
2019 | JMP I [ENDIO /RESTORE DSRN ENTRY AND QUIT | |
2020 | ||
2021 | RECCTR, 0 | |
2022 | \f/DIRECT-ACCESS I/O | |
2023 | ||
2024 | RWDACC, JMS I [RWINIT /"READ(N'R)" OR "WRITE(N'R)" | |
2025 | 1000 /DIRECT ACCESS IS UNFORMATTED I/O | |
2026 | TAD I XR | |
2027 | DCA T /GET BLOCKS/RECORD FACTOR FROM D.A. TABLE | |
2028 | JMS I [ARGLD /GET RECORD NUMBER | |
2029 | JMS I [FFIX /CONVERT TO INTEGER | |
2030 | TAD T | |
2031 | TAD ACI | |
2032 | ISZ T /MULTIPLY RECORD NUMBER BY BLOCKS/RECORD | |
2033 | JMP .-2 /TO GET RELATIVE BLOCK NUMBER | |
2034 | DCA RELBLK | |
2035 | TAD I XR | |
2036 | SNA /THIS LOC SHOULD NOT BE ZERO! | |
2037 | DAERR, JMS I ERR | |
2038 | DCA FGPBF /IT SHOULD BE AN FSTA + THE FIELD | |
2039 | TAD I XR /IN WHICH THE CONTROL VARIABLE IS | |
2040 | DCA BIOPTR /STORED. THE NEXT WORD IS THE ADDRESS | |
2041 | JMS I [FPGO /OF THE CONTROL VARIABLE IN THAT FIELD | |
2042 | FADD1 /ADD 1 TO RECORD # AND STORE IN CONTROL VAR | |
2043 | TAD DUMPIT /*K* "DCA T" SAME AS "CLA" HERE | |
2044 | JMP UNFIO /NOW GO DO A REGULAR BINARY READ/WRITE | |
2045 | ||
2046 | UDOIO, 0 | |
2047 | ISZ RECCTR /BUMP NUMBER OF RECORDS TRANSFERRED | |
2048 | TAD BADFLD | |
2049 | AND [7400 | |
2050 | TAD [377 /FORM POINTER TO LAST WORD IN BUFFER | |
2051 | DCA BIOPTR | |
2052 | TAD RECCTR | |
2053 | JMS BUFFLD | |
2054 | DCA I BIOPTR /FOR WRITE, PUT RECORD NUMBER IN 256TH WORD | |
2055 | UDOIOL, DCA CHRPTR | |
2056 | AC4000 | |
2057 | AND RWFLAG | |
2058 | JMS I [MASSIO /DO I/O (CHRPTR=0 TO FORCE I/O) | |
2059 | JMS BUFFLD | |
2060 | TAD RECCTR | |
2061 | CMA STL /FOR READ, CHECK THE INPUT | |
2062 | TAD I BIOPTR /SEQUENCE NUMBER TO MAKE SURE IT IS | |
2063 | CDF 0 /NO LARGER THAN THE ONE WE EXPECT. | |
2064 | SEQCHK, SZL CLA /*K* IF IT IS LARGER THIS IMPLIES THAT WE | |
2065 | JMP I UDOIO /ARE STILL IN THE MIDDLE OF THE LAST | |
2066 | JMP UDOIOL /RECORD AND SO WE READ AGAIN. | |
2067 | \f/DEFINE FILE PROCESSOR | |
2068 | ||
2069 | DFINE, JMS I [RWINIT /SET UP A POINTER INTO THE D.A. TABLE | |
2070 | 1000 /DIRECT ACCESS I/O IS UNFORMATTED | |
2071 | JMS I [ARGLD /GET NUMBER OF RECORDS | |
2072 | JMS I [FFIX | |
2073 | TAD ACI | |
2074 | CIA | |
2075 | DUMPIT, DCA T /SAVE IT FOR MULTIPLY | |
2076 | JMS I [ARGLD /GET THE NUMBER OF WORDS/RECORD | |
2077 | JMS I [FPGO /CONVERT WORDS TO BLOCKS | |
2078 | FWTOBL | |
2079 | JMS I [FFIX /CONVERT TO INTEGER | |
2080 | ISZ ACI | |
2081 | TAD ACI /MULTIPLY THE NUMBER OF BLOCKS/RECORD | |
2082 | ISZ T /BY THE NUMBER OF RECORDS | |
2083 | JMP .-2 | |
2084 | DCA RELBLK /TO GET THE FILE LENGTH IN BLOCKS | |
2085 | TAD ACI | |
2086 | CIA | |
2087 | DCA I XR /STORE NUMBER OF BLOCKS/RECORD | |
2088 | JMS I [ARGLD /GET POINTER TO CONTROL VARIABLE | |
2089 | TAD FGPBF | |
2090 | TAD (FSTA-FLDA /CHANGE A LOAD TO A STORE | |
2091 | DCA I XR /SAVE "FSTA CONTROL-VARIABLE" | |
2092 | TAD BIOPTR | |
2093 | DCA I XR | |
2094 | TAD TOTBLK | |
2095 | CMA CLL | |
2096 | TAD RELBLK /MAKE SURE WE HAVE ROOM FOR THE FILE | |
2097 | SZLCLA, SZL CLA | |
2098 | DFERR, JMS I ERR /WE DON'T | |
2099 | AC7776 | |
2100 | AND FFLAGS | |
2101 | IAC /FORCE "END-FILED" BIT FOR CLOSE | |
2102 | JMP I (SETTOT /SET LENGTH AND EXIT | |
2103 | PAGE | |
2104 | \f/SWAPPER AND ERROR ROUTINE | |
2105 | ||
2106 | SWAP, JMS I [FETPC /SWAPPER CALLING SEQUENCE: | |
2107 | DCA T / TRAP3 SWAP | |
2108 | TAD T / ADDR OVLY*4000000+LVL*100000+ENTRYADR | |
2109 | AND [7 | |
2110 | TAD (JA | |
2111 | DCA STRTUP /STORE JA TO ENTRY POINT | |
2112 | JMS I [FETPC | |
2113 | DCA STRTUP+1 | |
2114 | TAD T | |
2115 | AND [70 | |
2116 | CLL RAR /FORM 4*LVL | |
2117 | TAD (OVLYTB /INDEX INTO LEVEL TABLE | |
2118 | DCA ADR | |
2119 | TAD T | |
2120 | AND [7400 | |
2121 | DCA T /T CONTAINS OVERLAY NUMBER IN BITS 0-3 | |
2122 | CDF 0 /WATCH D.F.! | |
2123 | TAD I ADR | |
2124 | TAD T /SEE IF THIS OVERLAY IS IN CORE | |
2125 | SNA CLA | |
2126 | JMP ITSIN /YES - DON'T LOAD | |
2127 | TAD T | |
2128 | CIA | |
2129 | DCA I ADR /MARK THIS OVERLAY IN CORE (OPTIMIST) | |
2130 | ISZ ADR | |
2131 | TAD I ADR | |
2132 | AND [7400 | |
2133 | DCA OVADR /SAVE INITIAL OVERLAY LOAD ADDRESS | |
2134 | TAD I ADR | |
2135 | AND [70 | |
2136 | DCA OVIOW /AND FIELD | |
2137 | ISZ ADR | |
2138 | TAD I ADR /GET STARTING BLOCK OF THIS LEVEL | |
2139 | DCA OVBLK | |
2140 | ISZ ADR | |
2141 | TAD I ADR | |
2142 | DCA OVLEN /STORE LENGTH OF OVERLAY IN BLOCKS | |
2143 | OVADLP, TAD T /LEVEL STARTING BLOCK + | |
2144 | SNA /(OVERLAY #) * (OVERLAY LENGTH) | |
2145 | JMP LOADOV /= OVERLAY STARTING BLOCK | |
2146 | TAD [7400 | |
2147 | DCA T | |
2148 | TAD OVBLK | |
2149 | TAD OVLEN | |
2150 | DCA OVBLK | |
2151 | JMP OVADLP | |
2152 | \f/SWAPPER - CONTINUED | |
2153 | ||
2154 | LOADLP, DCA OVLEN /STORE UPDATED OVERLAY LENGTH | |
2155 | TAD OVIOW /GET LAST READ CONTROL WORD | |
2156 | RAL | |
2157 | AND [7400 /CONVERT BLOCK COUNT TO WORD COUNT | |
2158 | TAD OVADR /INCREMENT OVERLAY LOAD ADDRESS (LINK = 0) | |
2159 | DCA OVADR | |
2160 | RTL | |
2161 | RTL /USE THE CARRY | |
2162 | TAD OVIOW /TO INCREMENT THE LOAD FIELD IF NECESSARY | |
2163 | AND [70 | |
2164 | DCA OVIOW /OVIOW CONTAINS ONLY THE LOAD FIELD NOW | |
2165 | ||
2166 | LOADOV, TAD OVADR | |
2167 | CIA /LOTSA CALCULATIONS HERE - OS/8 HANDLERS | |
2168 | SNA /CAN'T READ MORE THAN 15 BLOCKS AT A TIME | |
2169 | TAD [7400 /AND CANNOT READ OVER FIELD BOUNDARIES | |
2170 | CLL RTL | |
2171 | RTL /SO WE MUST BREAK UP THE OVERLAY READ | |
2172 | CMA CML RAL /INTO SEVERAL SMALL READS OF MAXIMAL LENGTH. | |
2173 | TAD OVLEN /THE NUMBER OF BLOCKS TO READ IS GIVEN BY: | |
2174 | CMA /MINIMUM(B,L,15) | |
2175 | SMA /WHERE B IS THE # OF BLOCKS LEFT IN THIS FIELD | |
2176 | CLA /AND L IS THE # OF BLOCKS LEFT IN THE OVERLAY | |
2177 | TAD OVLEN /AND 15 IS THE # OF BLOCKS A HANDLER CAN READ | |
2178 | DCA T / ANSWER IN T | |
2179 | TAD T | |
2180 | CLL RTR | |
2181 | RTR | |
2182 | RTR /TURN NUMBER OF BLOCKS INTO 0S/8 BLOCK COUNT | |
2183 | TAD OVIOW | |
2184 | DCA OVIOW /ADD FIELD BITS AND STORE AS I/O CONTROL WD | |
2185 | TAD OVHCDW /GET OVERLAY HANDLER CODE WORD | |
2186 | JMS I (GETHND /LOAD HANDLER INTO FIELD 0 | |
2187 | JMS I OVHND | |
2188 | OVIOW, 0 | |
2189 | OVADR, 0 | |
2190 | OVBLK, 0 | |
2191 | OVERR, JMS I ERR /WHOOPS - OVERLAY READ ERROR | |
2192 | JMS RECOVR /CLEAR ANY NASTY FLAGS LEFT BY HANDLER | |
2193 | TAD T | |
2194 | TAD OVBLK | |
2195 | DCA OVBLK /UPDATE BLOCK NUMBER | |
2196 | TAD T | |
2197 | CIA | |
2198 | TAD OVLEN /BUMP DOWN RECORD COUNT | |
2199 | SZA /SEE IF WE ARE DONE | |
2200 | JMP LOADLP /NO - PREPARE FOR NEXT READ | |
2201 | \f/OVERLAY IN CORE - EXECUTE IT | |
2202 | ||
2203 | ITSIN, JMS I [FPGO /START UP FPP | |
2204 | STRTUP /AND JA TO ENTRY POINT | |
2205 | ||
2206 | TRAP5I, | |
2207 | TRAP6I, | |
2208 | TRAP7I, | |
2209 | FPAUSE, | |
2210 | FPPERR, JMS I ERR /SHOULD NEVER GET HERE | |
2211 | ||
2212 | STRTUP, 0;0 /JA ENTRY | |
2213 | OVLEN, 0 | |
2214 | OVHND, 0 /SET BY LOADER | |
2215 | OVHCDW, 0 /SET BY LOADER | |
2216 | ||
2217 | RECOVR, 0 /ROUTINE TO CLEAN UP ANY FLAGS | |
2218 | DCA CTCINH /LEFT ON BY SLOPPY OS/8 HANDLERS. | |
2219 | YRCOVR, NOP | |
2220 | NOP | |
2221 | NOP | |
2222 | NOP /RIGHT NOW I DON'T KNOW OF ANY. | |
2223 | NOP | |
2224 | NOP | |
2225 | NOP | |
2226 | NOP | |
2227 | ION | |
2228 | JMP I RECOVR | |
2229 | ||
2230 | FSTTMP, FSTA+LONG | |
2231 | FTEMP | |
2232 | FEXIT | |
2233 | ||
2234 | TEN, 4;2400;0;0;0;0 /10.0D0 | |
2235 | FLTG85, 7;2520;0 /85.0 | |
2236 | PAGE | |
2237 | \f/INPUT BUFFER - CONTAINS STARTUP CODE | |
2238 | ||
2239 | INBUFR, -206 /LENGTH | |
2240 | 0 /INPUT LINE BUFFER - FIRST A LITTLE PADDING, | |
2241 | ||
2242 | /RTS EXECUTION INITIALIZATION - IN INPUT BUFFER | |
2243 | ||
2244 | FPSTRT, 6601 /CLEAR DF32 FLAG | |
2245 | PCF /HSP FLAG | |
2246 | RRB /HSR FLAG | |
2247 | PP7600, 7600 /CLEAR READER CHAR | |
2248 | 6135 /CLEAR KW12 OR DK8-EP EVENT FLAGS | |
2249 | CLA | |
2250 | 6132 /STOP KW12 CLOCKS | |
2251 | 6134 /DISABLE KW12 INTERRUPTS | |
2252 | 6530 /CLEAR AD8-EA FLAGS | |
2253 | 6050 /CLEAR VC8/E FLAG | |
2254 | 6500 /DISABLE XY8/E INTERRUPTS | |
2255 | STA | |
2256 | 6130 /DISABLE DK8-EP INTERRUPTS | |
2257 | CLA /LEAVE SPACE FOR ADDITIONAL CLEARS | |
2258 | NOP | |
2259 | NOP | |
2260 | NOP | |
2261 | NOP | |
2262 | NOP | |
2263 | NOP | |
2264 | NOP | |
2265 | NOP | |
2266 | NOP | |
2267 | NOP | |
2268 | NOP | |
2269 | DCA EOLSW | |
2270 | LDPROG, JMS I [FPGO /START UP FPP OR PSEUDO-FPP | |
2271 | STSWAP | |
2272 | HLTNOP, NOP /SET TO HLT IF /H SPECIFIED, | |
2273 | JMP PRTCR /SKP IF /P SPECIFIED | |
2274 | TAD .-1 | |
2275 | DCA LDPROG /BYPASS LOADING ON STARTUP | |
2276 | TAD PCHWD /HLT | |
2277 | DCA I (PDPXIT+1 | |
2278 | \f/ROUTINE TO PUNCH RTS+PROGRAM ON FORTRAN UNIT 9 (UNCOMMENTED) | |
2279 | ||
2280 | PPTR, TAD P11 | |
2281 | PCKSUM, DCA ACI | |
2282 | JMS I (LDDSRN | |
2283 | SMA CLA | |
2284 | JMP I [UNTERR | |
2285 | JMP LDRTLR | |
2286 | FLDLP, DCA PPTR | |
2287 | DCA PCKSUM | |
2288 | TAD (100 | |
2289 | JMS SIXOUT | |
2290 | JMS SIXOUT | |
2291 | TAD FLD | |
2292 | AND [70 | |
2293 | JFMOUT, JMS I [FMTOUT /*K* ONLY WORKS FOR FIELD 0-3 | |
2294 | TAD (100 | |
2295 | JMS SIXOUT | |
2296 | JMS SIXOUT | |
2297 | FLD, CDF 0 | |
2298 | TAD I PPTR | |
2299 | CDF 0 | |
2300 | JMS PCHWD | |
2301 | ISZ PPTR | |
2302 | P11, 11 | |
2303 | ISZ PCTR | |
2304 | JMP FLD | |
2305 | TAD PCKSUM | |
2306 | JMS PCHWD | |
2307 | TAD FLD | |
2308 | TAD (10 | |
2309 | DCA FLD | |
2310 | LDRTLR, TAD PP7600 | |
2311 | DCA ACH | |
2312 | TAD [200 | |
2313 | JMS SIXOUT | |
2314 | ISZ ACH | |
2315 | JMP .-3 | |
2316 | ISZ FCNT | |
2317 | JMP FLDLP | |
2318 | TAD (6000 | |
2319 | DCA FFLAGS | |
2320 | DCA I (ENDFLS /*K* SAME KLUDGE AS CALXIT | |
2321 | JMS I (ENDFL | |
2322 | DCA I (PDPXIT+1 /WIPE HALT SO WE CAN RETURN TO OS/8 | |
2323 | JMP I (PDPXIT-1 | |
2324 | \fPCHWD, HLT | |
2325 | DCA ACH | |
2326 | TAD ACH | |
2327 | RTR | |
2328 | RTR | |
2329 | RTR | |
2330 | AND [77 | |
2331 | JMS SIXOUT | |
2332 | TAD ACH | |
2333 | AND [77 | |
2334 | JMS SIXOUT | |
2335 | JMP I PCHWD | |
2336 | ||
2337 | SIXOUT, 0 | |
2338 | DCA T | |
2339 | CLA IAC | |
2340 | DCA EOLSW | |
2341 | TAD PCKSUM | |
2342 | TAD T | |
2343 | DCA PCKSUM | |
2344 | TAD T | |
2345 | TAD (-300 | |
2346 | JMS I [FMTOUT | |
2347 | JMP I SIXOUT | |
2348 | ||
2349 | PCTR, 200 /DON'T PUNCH 07600! | |
2350 | FCNT, 0 | |
2351 | \fPRTCR, TAD (215 | |
2352 | JMS I PTTY /PRINT CARRIAGE RETURN | |
2353 | TAD JFMOUT | |
2354 | DCA I (ERRENB /ENABLE ERROR TRACEBACK | |
2355 | JMS I [FPGO | |
2356 | STJUMP /NOW JUMP TO THE NEWLY-LOADED CODE | |
2357 | STSWAP, TRAP3 /TRAP3 | |
2358 | SWAP | |
2359 | 0 | |
2360 | .+1 | |
2361 | TRAP3 | |
2362 | HLTNOP | |
2363 | PAGE | |
2364 | STJUMP, 0 | |
2365 | 0 | |
2366 | ZBLOCK INBUFR+210-. /PAD OUT TO END OF BUFFER | |
2367 | \f/OVERLAY AND DSRN TABLES | |
2368 | ||
2369 | *.-4 /FIRST ENTRY IN OVLYTB ONLY NEEDED TO LOAD MAIN PGM | |
2370 | ||
2371 | OVLYTB, ZBLOCK 40 /OVERLAY TABLE | |
2372 | ||
2373 | DSRN, PTR; ZBLOCK 10 | |
2374 | PTP; ZBLOCK 10 | |
2375 | LPT; ZBLOCK 10 | |
2376 | TTY; 0;0 | |
2377 | 1234 /*K* PREVENT PROBLEM IN | |
2378 | ZBLOCK 5 /RWINIT INVOLVING WRITE | |
2379 | /AFTER READ ON TELETYPE | |
2380 | ZBLOCK 55 | |
2381 | ||
2382 | ZBLOCK 12 /FORMAT PARENTHESIS PUSHDOWN LIST | |
2383 | FMTPDL, 0 /GUARD WORD | |
2384 | PAGE | |
2385 | \f/SOFTWARE FLOATING POINT ROUTINES WHICH ARE USED | |
2386 | /EVEN IF FLOATING HARDWARE IS PRESENT | |
2387 | ||
2388 | /** MUST NOT DESTROY FAC! ** | |
2389 | ||
2390 | FFIX, 0 /ROUTINE TO FIX FAC | |
2391 | STA /ANSWER IS RETURNED IN ACI | |
2392 | TADACX, TAD ACX /ABS(FAC) MUST BE LESS THAN 2048 | |
2393 | CLL /DETERMINE IF FAC EXPONENT IS | |
2394 | TAD (-13 /BETWEEN 1 AND 14 | |
2395 | SNA | |
2396 | JMP FIXBIG /14 IS A SPECIAL CASE | |
2397 | EAEFIX, DCA ACI | |
2398 | SZL | |
2399 | JMP FIXDNE /EXP GT 14 OR LT 1 - RETURN 0 | |
2400 | TAD ACH | |
2401 | JMP FIXISZ | |
2402 | FIXLP, CLL /0 IN LINK | |
2403 | SPA /IS IT LESS THAN 0? | |
2404 | CML /YES-PUT A 1 IN LINK | |
2405 | RAR /SCALE RIGHT | |
2406 | FIXISZ, ISZ ACI /DONE YET? | |
2407 | JMP FIXLP /NO | |
2408 | FIXDNE, DCA ACI /RETURN WITH ANSWER IN ACI | |
2409 | JMP I FFIX /RETURN | |
2410 | ||
2411 | FIXBIG, TAD ACL /IF EXP IS 14 WE MUST SHIFT AC FRACTION | |
2412 | RAL /LEFT ONE PLACE TO INTEGERIZE IT. | |
2413 | CLA | |
2414 | TAD ACH | |
2415 | RAL | |
2416 | JMP FIXDNE /STORE ANSWER AND RETURN | |
2417 | ||
2418 | SETB, TAD DATAF | |
2419 | DCA I (BASCDF /SET BASE PAGE LOCATION | |
2420 | TAD ADR | |
2421 | DCA BASADR | |
2422 | JMP I FPNXT | |
2423 | \f/ | |
2424 | /SHIFT FAC LEFT 1 BIT | |
2425 | / | |
2426 | AL1, 0 | |
2427 | TAD AC1 /GET OVERFLOW BIT | |
2428 | CLL RAL /SHIFT LEFT | |
2429 | DCA AC1 /STORE BACK | |
2430 | TAD ACL /GET LOW ORDER MANTISSA | |
2431 | RAL /SHIFT LEFT | |
2432 | DCA ACL /STORE BACK | |
2433 | TAD ACH /GET HI ORDER | |
2434 | RAL | |
2435 | DCA ACH /STORE BACK | |
2436 | JMP I AL1 /RETN. | |
2437 | / | |
2438 | /SHIFT FAC RIGHT-ENTER WITH COUNT-1 IN AC (POSITIVE) | |
2439 | / | |
2440 | ACSR, 0 | |
2441 | CMA /AC CONTAINS COUNT-1 | |
2442 | DCA AC0 /STORE COUNT | |
2443 | LOP1, TAD ACH /GET HIGH ORDER MANTISSA | |
2444 | CLL | |
2445 | SPA /PROPAGATE SIGN | |
2446 | CML | |
2447 | RAR /SHIFT RIGHT 1, PROPAGATING SIGN | |
2448 | DCA ACH /STORE BACK | |
2449 | TAD ACL /GET LOW ORDER | |
2450 | RAR /SHIFT IT | |
2451 | DCA ACL /STORE BACK | |
2452 | ISZ ACX /INCREMENT EXPONENT | |
2453 | NOP | |
2454 | ISZ AC0 /DONE? | |
2455 | JMP LOP1 /NO-LOOP | |
2456 | RAR | |
2457 | DCA AC1 /SAVE 1 BIT OF OVERFLOW | |
2458 | JMP I ACSR /YES-RETN-AC=L=0 | |
2459 | / | |
2460 | /FLOATING NEGATE | |
2461 | / | |
2462 | FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE) | |
2463 | TAD ACL /GET LOW ORDER FAC | |
2464 | CLL CMA IAC /NEGATE IT | |
2465 | DCA ACL /STORE BACK | |
2466 | CML RAL /ADJUST OVERFLOW BIT AND | |
2467 | TAD ACH /PROPAGATE CARRY-GET HI ORD | |
2468 | CLL CMA IAC /NEGATE IT | |
2469 | DCA ACH /STORE BACK | |
2470 | JMP I FFNEG | |
2471 | \fOADD, 0 /ADD OPERAND TO FAC | |
2472 | CLL | |
2473 | TAD AC2 /ADD OVERFLOW WORDS | |
2474 | TAD AC1 | |
2475 | DCA AC1 | |
2476 | RAL /ROTATE CARRY | |
2477 | TAD OPL /ADD LOW ORDER MANTISSAS | |
2478 | TAD ACL | |
2479 | DCA ACL | |
2480 | RAL | |
2481 | TAD OPH /ADD HI ORDER MANTISSAS | |
2482 | TAD ACH | |
2483 | DCA ACH | |
2484 | JMP I OADD /RETN. | |
2485 | ||
2486 | FETPC, 0 | |
2487 | ISZ PC | |
2488 | JMP PCCDF /NO FIELD BUMP | |
2489 | ISZ APT /BUMP FIELD FOR FPP RESTART (IN CASE FPP EXISTS) | |
2490 | FPC10, 10 /PROTECTION FOR ISZ | |
2491 | TAD PCCDF | |
2492 | TAD FPC10 | |
2493 | DCA PCCDF | |
2494 | PCCDF, HLT | |
2495 | TAD I PC | |
2496 | JMP I FETPC | |
2497 | ||
2498 | EEPUT, STL /EXTENDED PRECISION STORE | |
2499 | EEGET, DCA ADR /EXTENDED PRCISION FETCH | |
2500 | TAD [-6 | |
2501 | DCA DATCDF | |
2502 | SNL | |
2503 | AC2000 /SET UP "TAD ACX" OR "DCA ACX" | |
2504 | TAD TADACX | |
2505 | DCA EEINST | |
2506 | EELOOP, SNL /LINK=1 MEANS STORE | |
2507 | TAD I ADR | |
2508 | EEINST, HLT | |
2509 | SZL | |
2510 | DCA I ADR | |
2511 | ISZ ADR | |
2512 | SKP | |
2513 | JMS I (DFBUMP | |
2514 | ISZ EEINST | |
2515 | ISZ DATCDF | |
2516 | JMP EELOOP | |
2517 | JMP I FPNXT | |
2518 | ||
2519 | FSTTM2, FSTA+LONG | |
2520 | FTEMP2 | |
2521 | FEXIT | |
2522 | / | |
2523 | FTEMP, ZBLOCK 6 | |
2524 | / | |
2525 | PAGE | |
2526 | \f/RUN-TIME SYSTEM ERROR LIST | |
2527 | ||
2528 | ERRLST, VARGER; ARGMSG | |
2529 | UERR; UMSG | |
2530 | FPOERR; FPOMSG | |
2531 | FMTERR; FMTMSG | |
2532 | UNTERR; UNTMSG | |
2533 | CTLBER; CTLBMS | |
2534 | INER; INMSG | |
2535 | IOVFLO; IOVMSG | |
2536 | IOERR; IOMSG | |
2537 | DAERR; DAMSG | |
2538 | FPPERR; FPPMSG | |
2539 | OVERR; OVMSG | |
2540 | EOFERR; INEMSG | |
2541 | FPOVER; OFLMSG | |
2542 | DFERR; DFMSG | |
2543 | -1; DV0MSG /BY ELIMINATION | |
2544 | \f/RTS ERROR MESSAGES | |
2545 | ||
2546 | ARGMSG, TEXT /BAD ARG/ | |
2547 | UMSG, TEXT /USER ERROR/ | |
2548 | FPOMSG, TEXT /PARENS TOO DEEP/ | |
2549 | FMTMSG, TEXT /FORMAT ERROR/ | |
2550 | UNTMSG, TEXT /UNIT ERROR/ | |
2551 | INMSG, TEXT /INPUT ERROR/ | |
2552 | OVMSG, TEXT /OVERLAY / | |
2553 | *.-1 | |
2554 | IOMSG, TEXT %I/O ERROR% | |
2555 | DAMSG, TEXT /NO DEFINE FILE/ | |
2556 | FPPMSG, TEXT /FPP ERROR/ | |
2557 | INEMSG, TEXT /EOF ERROR/ | |
2558 | DV0MSG, TEXT /DIVIDE BY 0/ | |
2559 | DFMSG, TEXT /D.F. TOO BIG/ | |
2560 | IOVMSG, TEXT /FILE / | |
2561 | *.-1 | |
2562 | OFLMSG, TEXT /OVERFLOW/ | |
2563 | CTLBMS, TEXT /^B/ | |
2564 | ||
2565 | USRERR, TAD ERRFLG /USER ERROR - OPTIONALLY NON-FATAL | |
2566 | DCA FATAL | |
2567 | UERR, JMS I ERR /PRINT MESSAGE | |
2568 | JMP I [RETURN /IF NON-FATAL, CONTINUE PROCESSING | |
2569 | ERRFLG, 0 /SET TO NON-ZERO IF /E SWITCH SPECIFIED | |
2570 | ||
2571 | TRPPRT, TRAP3 /CODE WHICH IS LOADED INTO PROGRAM PROLOGUES | |
2572 | PRTNAM /BY THE ERROR TRACEBACK ROUTINE | |
2573 | PAGE | |
2574 | \fMAKCDF, 0 /ROUTINE TO MAKE A CDF FROM AC9-11 | |
2575 | RTL | |
2576 | RAL | |
2577 | AND [70 | |
2578 | TAD ERCDF /STRAIGHTFORWARD ENOUGH, ISN'T IT? | |
2579 | JMP I MAKCDF | |
2580 | ||
2581 | RD2WR, 0 /ROUTINE CALLED WHEN SWITCHING | |
2582 | STA /FROM READ TO WRITE. (CALLED ONLY ONCE!) | |
2583 | TAD RELBLK /BUMP BLOCK # BACK FROM "NEXT BUFFER'S BLOCK #" | |
2584 | DCA RELBLK /TO "THIS BUFFER'S BLOCK #". | |
2585 | TAD CHRCTR /HOWEVER, IF WE ARE AT THE VERY END OF A | |
2586 | IAC /BUFFER, WRITE ROUTINE EXPECTS US TO | |
2587 | SZA CLA /BE AT THE BEGINNING OF THE NEXT BUFFER, | |
2588 | JMS I [MASSIO /SO RE-READ THIS BUFFER AND SET POINTERS | |
2589 | JMP I RD2WR | |
2590 | ||
2591 | /RUN-TIME-SYSTEM ERROR ROUTINE | |
2592 | ||
2593 | ERROR, 0 | |
2594 | ERCDF, CDF 0 | |
2595 | CLA | |
2596 | TAD (ERRLST-2 | |
2597 | DCA XR | |
2598 | ERRLP, ISZ XR /SEARCH ERROR LIST FOR CALLING ADDRESS | |
2599 | TAD I XR /ERROR LIST CONTAINS | |
2600 | CMA | |
2601 | SZA /CALLING ADDRESSES AND | |
2602 | TAD ERROR /CORRESPONDING MESSAGES | |
2603 | SZA CLA | |
2604 | JMP ERRLP | |
2605 | TAD I XR | |
2606 | DCA I (FMTADR | |
2607 | DCA I (FMTDF | |
2608 | TAD PTTY | |
2609 | DCA HAND /QUICK FUDGE FOR TTY OUTPUT | |
2610 | DCA HCODEW /TO SET CARRIAGE CONTROL | |
2611 | AC4000 | |
2612 | DCA RWFLAG | |
2613 | JMS I [EOLINE /TYPE CARRET AND SET EOLSW | |
2614 | DCA FMTBYT /INITIALIZE MESSAGE PTR | |
2615 | ERPTLP, JMS I [FMTOUT /OUTPUTS LF FIRST TIME | |
2616 | JMS I [FMTGCH /GET CHAR USING FORMAT ROUTINES | |
2617 | ISZ FMTBYT | |
2618 | SZA | |
2619 | JMP ERPTLP /LOOP UNTIL 0 CHAR | |
2620 | \f/PRINT ROUTINE NAME AND LINE NUMBER | |
2621 | ||
2622 | PRTNAM, TAD [40 | |
2623 | ERRENB, JMP I E7605 /*K* IN CASE INITIALIZATION OR /P GET ERRORS | |
2624 | / PREVIOUS LINE REPLACED WITH: | |
2625 | / JMS I [FMTOUT /OUTPUT A BLANK(LF ON EXTRA LINES) | |
2626 | JMS I [FPGO /START UP FPP | |
2627 | GTNMPT /GET POINTER TO NAME IN FAC | |
2628 | TAD ACH | |
2629 | DCA I (FMTDF /SET UP FORMAT GET CHARACTER ROUTINE | |
2630 | TAD ACL /TO GET CHARACTERS OF ROUTINE NAME | |
2631 | DCA I (FMTADR | |
2632 | DCA FMTBYT | |
2633 | TAD [-6 | |
2634 | DCA ISN /6 CHARACTER NAME | |
2635 | PRTNML, JMS I [FMTGCH | |
2636 | SNA | |
2637 | TAD [40 /AVOID PRINTING RANDOM @S | |
2638 | JMS I [FMTOUT /GET AND PRINT A CHARACTER | |
2639 | ISZ FMTBYT | |
2640 | ISZ ISN | |
2641 | JMP PRTNML | |
2642 | TAD [40 | |
2643 | JMS I [FMTOUT /SEPARATE THE NAME BY A SPACE | |
2644 | TAD [-4 /FROM THE LINE NUMBER. | |
2645 | DCA ISN | |
2646 | PTLNLP, TAD ISN+1 | |
2647 | CLL RTL | |
2648 | RAL | |
2649 | DCA ISN+1 /PRINT LINE NUMBER IN OCTAL | |
2650 | TAD ISN+1 /BECAUSE THAT IS THE WAY IT APPEARS | |
2651 | RAL /IN THE FORTRAN PROGRAM LISTING | |
2652 | AND [7 | |
2653 | JMS I (DIGIT | |
2654 | ISZ ISN | |
2655 | JMP PTLNLP | |
2656 | ||
2657 | JMS I [EOLINE /OUTPUT FINAL CR | |
2658 | TAD FATAL | |
2659 | SNA CLA /FATAL ERROR? | |
2660 | JMP TRCBAK /YES - GIVE FULL TRACEBACK | |
2661 | DCA FATAL /"NON-FATAL" FLAG MUST BE SET EACH TIME | |
2662 | JMP I ERROR | |
2663 | TRCBAK, JMS I [FPGO /START UP FPP | |
2664 | UP1LEV /MOVE UP TO CALLING ROUTINE | |
2665 | /FPP CODE DOES A "TRAP3 PRTNAM" | |
2666 | ISN, 0;0 | |
2667 | \f/FPP CODE FOR ERROR ROUTINE | |
2668 | ||
2669 | GTNMPT, STARTD | |
2670 | XTA 0 /LOAD LINE NUMBER FROM XR 0 | |
2671 | FSTA+LONG | |
2672 | ISN /STORE AWAY | |
2673 | FLDA+BASE 10 /LOAD POINTER TO PROLOGUE | |
2674 | FSUB+LONG | |
2675 | THREE /NAME IS 3 LOCATIONS BEFORE PROLOGUE | |
2676 | STARTF /FOR NON-FPP VERSION | |
2677 | THREE, FEXIT;3 /*K* DEPENDS ON FACT THAT FEXIT=0 | |
2678 | ||
2679 | UP1LEV, STARTD | |
2680 | FLDA+BASE 11 /GET THE UPWARD POINTER | |
2681 | JNE | |
2682 | NOTMN /ZERO MEANS MAIN PROGRAM | |
2683 | TRAP3 | |
2684 | E7605, 7605 /GO AWAY IF MAIN PROGRAM | |
2685 | NOTMN, FSTA+BASE 0 | |
2686 | LDX 1 | |
2687 | 2 /WE WILL STORE A "TRAP3 PRTNAM" | |
2688 | FLDA+LONG /IN THE FIFTH LOCATION OF THE PROLOGUE, | |
2689 | TRPPRT | |
2690 | FSTA+IND 0+10 /WHERE THE FIRST 4 LOCS WERE A SETX AND SETB. | |
2691 | FLDA+BASE 0 /GET THE PROLOGUE ADDRESS AGAIN | |
2692 | JAC /JUMP TO IT. | |
2693 | ||
2694 | ACMDGT, FMUL+LONG | |
2695 | TEN | |
2696 | FSTA+LONG | |
2697 | FTEMP | |
2698 | FLDA+LONG | |
2699 | DGT /GET UNNORMALIZED DIGIT INTO AC | |
2700 | FNORM /NORMALIZE IT | |
2701 | FADTMP, FADD+LONG | |
2702 | FTEMP | |
2703 | FEXIT | |
2704 | LPBUFR, ZBLOCK 4 | |
2705 | LPBUF2 | |
2706 | PAGE | |
2707 | \fHPLACE, /ZBLOCK 400 /HANDLER SWAP AREA | |
2708 | ||
2709 | /VARIOUS INITIALIZATION STUFF OVERLAYING THE RTS HANDLER AREA | |
2710 | ||
2711 | QLHDR, 0 /SHOULD BE A 2 FOR A LOADER IMAGE | |
2712 | QRTSWP, ZBLOCK 2 /INITIAL SWAP ARGS TO LOAD USER MAIN | |
2713 | QHGHAD, ZBLOCK 2 /HIGHEST ADDRESS USED | |
2714 | QVERNO, 0 /LOADER VERSION # | |
2715 | QDPFLG, 0 /"PROGRAM USES D.P." FLAG | |
2716 | QUSRLV, ZBLOCK 40 /USER OVERLAY INFO | |
2717 | ||
2718 | /EAE OVERLAY TO FIX AND FLOAT | |
2719 | ||
2720 | EFXFLT, RELOC EAEFIX | |
2721 | ||
2722 | FIXEAE, CMA | |
2723 | DCA FIXSH /SHIFT COUNT BETWEEN 0 AND 12 | |
2724 | SZL | |
2725 | JMP FIX0 /NOT INTEGERIZABLE | |
2726 | TAD ACH | |
2727 | ASR | |
2728 | FIXSH, 0 | |
2729 | FIX0, DCA ACI | |
2730 | JMP I FFIX | |
2731 | ||
2732 | FXFLTC= .-FIXEAE | |
2733 | RELOC | |
2734 | \f/SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF | |
2735 | /BANKS IN AC. | |
2736 | /MUST RUN IN FIELD 0. | |
2737 | ||
2738 | CORE, 0 | |
2739 | TAD C6203 | |
2740 | RDF | |
2741 | DCA CORRET | |
2742 | CORELP, CDF 0 /NEEDED FOR PDP-8L | |
2743 | TAD I C7777 | |
2744 | AND COR70 /IF BITS 6-8 OF LOCATION 7777 ARE NOT ZERO, | |
2745 | CLL RTR /THEY SPECIFY THE LAST FIELD OF CORE | |
2746 | RAR /WHICH WE SHOULD USE. | |
2747 | SZA | |
2748 | JMP CORRET /SO RETURN THAT AMOUNT | |
2749 | TAD TRYFLD /GET FLD TO TST | |
2750 | CLL RTL | |
2751 | RAL | |
2752 | AND COR70 /MASK USEFUL BITS | |
2753 | TAD CORELP | |
2754 | DCA COR706 /SET UP CDF TO FLD | |
2755 | COR706, 0 | |
2756 | TAD I CORLOC /SAV CURRENT CONTENTS | |
2757 | NOP /HACK FOR PDP-8 | |
2758 | DCA .-3 | |
2759 | TAD .-2 /7000 IS A GOOD PATTERN | |
2760 | DCA I CORLOC | |
2761 | COR70, 70 /HACK FOR PDP-8.,NO-OP | |
2762 | TAD I CORLOC /TRY TO READ BK 7000 | |
2763 | CO7400, 7400 /HACK FOR PDP-8,.NO-OP | |
2764 | TAD CO7400 /GUARD AGAINST WRAP AROUND | |
2765 | TAD CORLOC+1 /TAD 1400 | |
2766 | SZA CLA | |
2767 | JMP .+5 /NON EXISTENT FLD EXIT | |
2768 | TAD COR706 /RESTORE CONTENS DESTROYED | |
2769 | DCA I CORLOC | |
2770 | ISZ TRYFLD /TRY NXT HIGHER FLD | |
2771 | JMP CORELP | |
2772 | STA | |
2773 | TAD TRYFLD | |
2774 | CORRET, 0 | |
2775 | JMP I CORE | |
2776 | CORLOC, CO7400 /ADR TO TST IN EACH FLD | |
2777 | 1400 /7000+7400+1400=0 | |
2778 | TRYFLD, 1 /CURRENT FLD TO TST | |
2779 | C6203, 6203 | |
2780 | C7777, 7777 | |
2781 | ||
2782 | DPTEST, STARTE /EXECUTED BY FPP DURING INITIALIZATION | |
2783 | FEXIT /CHECK WHETHER DOUBLE PRECISION ENABLED | |
2784 | \f/TABLE OF MODIFICATIONS TO MAKE TO FRTS FOR BACKGROUND OPERATION | |
2785 | /UNDER RTS-8. FORMAT OF TABLE IS: POINTER TO FIRST WORD OF BLOCK - 1 | |
2786 | / (0 TERMINATES) FOLLOWED BY LIST OF REPLACEMENT WORDS (0 TERMINATES). | |
2787 | ||
2788 | BKRLST, YLPT-1 /LINE PRINTER OUTPUT ROUTINE | |
2789 | RELOC YLPT | |
2790 | LLS | |
2791 | CLA /DON'T DO RING-BUFFERING - JUST "OUTPUT" CHAR. | |
2792 | JMS CTCBCK /CHECK FOR ^C OR ^B | |
2793 | JMP I LPT | |
2794 | FJCTCT, JMS CTCBCK /COME HERE FROM INTERPRETED FPP JUMPS | |
2795 | JMP I FPNXT /CHECK FOR ^C,^B AND RETURN TO INTERPRETER | |
2796 | RELOC | |
2797 | 0 | |
2798 | ||
2799 | YPTP-1 /PAPER-TAPE PUNCH ROUTINE | |
2800 | CLA /ALL PAPER-TAPE I/O ILLEGAL | |
2801 | 0 | |
2802 | YPTR-1 /PAPER TAPE READER ROUTINE | |
2803 | CLA /ALL PAPER-TAPE I/O ILLEGAL | |
2804 | 0 | |
2805 | ||
2806 | YTTY-1 /TELETYPE INPUT/OUTPUT ROUTINE | |
2807 | RELOC YTTY | |
2808 | SNA | |
2809 | JMP KBDRTS /AC=0 MEANS INPUT | |
2810 | TSF | |
2811 | JMP .-1 /HANG UNTIL OUTPUT BUFFER NOT FULL | |
2812 | TLS | |
2813 | CLA | |
2814 | JMS CTCBCK /CHECK FOR ^C OR ^B TYPED | |
2815 | JMP I TTY | |
2816 | KBDRTS, KSF | |
2817 | JMP .-1 /HANG UNTIL CHAR RECEIVED | |
2818 | JMS CTCBCK /CHECK FOR ^C OR ^B | |
2819 | KRB | |
2820 | AND KB177 /STRIP PARITY | |
2821 | TAD KB177 | |
2822 | IAC /NOW FORCE PARITY BIT ON (177+1=200) | |
2823 | JMP I TTY | |
2824 | ||
2825 | CTCBCK, . /*K* CAN'T BE 0! | |
2826 | KRS /PEEK AT NEXT CHAR IN BUFFER | |
2827 | AND KB177 | |
2828 | TAD KBM2 | |
2829 | CLL RAR | |
2830 | SNA CLA /IS IT ^C OR ^B? | |
2831 | KSF /AND IS IT REALLY PENDING? | |
2832 | JMP I CTCBCK /NO - JUST RETURN WITH AC=0 | |
2833 | JMP BEEORC /TERMINATE JOB - LINK HAS ^C/^B FLAG | |
2834 | KB177, 177 | |
2835 | KBM2, -2 | |
2836 | RELOC | |
2837 | 0 | |
2838 | \f/CONTINUATION OF TABLE OF RTS-8 OVERLAYS TO FRTS | |
2839 | ||
2840 | YHIOF-1 /"GET OS/8 HANDLER" ROUTINE | |
2841 | NOP /ELIMINATE "IOF" INSTRUCTION | |
2842 | 0 | |
2843 | ||
2844 | YRCOVR-1 /"RECOVER FROM OS/8 HANDLER" ROUTINE | |
2845 | RELOC YRCOVR | |
2846 | JMP I RECOVR /SHORT-CIRCUIT PORTION OF ROUTINE WHICH DOES | |
2847 | RELOC /AN "ION" | |
2848 | 0 | |
2849 | ||
2850 | YFJMP-1 /FPP INTERPRETER - SUCCESSFUL JUMP SECTION | |
2851 | FJCTCT /TEST FOR ^C OR ^B TYPED BEFORE | |
2852 | 0 /RETURNING TO THE INTERPRETER | |
2853 | ||
2854 | 0 /** LIST TERMINATOR ** | |
2855 | \f/ERROR MESSAGES FOR RUN-TIME LOADER - IN HANDLER BUFFER | |
2856 | /*K* CANNOT LOAD BELOW HPLACE+200 AS HPLACE-HPLACE+177 ARE DESTROYED BY HEADER! | |
2857 | ||
2858 | IFNZRO .-HPLACE-200&4000 <__ERROR__> | |
2859 | ||
2860 | NOLI, TEXT /NOT A LOADER IMAGE/ | |
2861 | NONMSG, TEXT /NO NUMERIC SWITCH/ | |
2862 | FILMSG, TEXT /FILE ERROR/ | |
2863 | SYSMSG, TEXT /SYSTEM DEVICE ERROR/ | |
2864 | TOOMCH, TEXT /MORE CORE REQUIRED/ | |
2865 | TOMNYH, TEXT /TOO MANY HANDLERS/ | |
2866 | LIOEMS, TEXT /CAN'T READ IT!/ | |
2867 | NODPMS, TEXT /CAUTION - NO DP/ | |
2868 | XVERMS, TEXT /FRTS V/ | |
2869 | *.-1 | |
2870 | XVERSN&70^7+XVERSN+4060 /VERSION NUMBER IN SIXBIT | |
2871 | XPATCH&77^100+40 /PATCH LEVEL | |
2872 | TEXT / / | |
2873 | PAGE | |
2874 | \f/FPP INTERPRETER STARTUP ROUTINE | |
2875 | ||
2876 | FPPINT= . /FOR FPP OVERLAY | |
2877 | RETURN, JMP I FPNXT /RETURN DOES SOMETHING DIFFERENT IF FPP PRESENT | |
2878 | ||
2879 | FPGO, 0 | |
2880 | FPGCDF, CDF 0 /NECESSARY? | |
2881 | CLA | |
2882 | TAD PC | |
2883 | DCA SAVPC /ALLOW ONE LEVEL OF RECURSIVENESS | |
2884 | TAD I (PCCDF | |
2885 | DCA SPCCDF | |
2886 | STA | |
2887 | TAD I FPGO | |
2888 | DCA PC | |
2889 | ISZ FPGO | |
2890 | TAD FPGCDF /FPGO STARTS UP THE FPP FROM FIELD 0 ONLY | |
2891 | DCA I (PCCDF | |
2892 | JMP I FPNXT | |
2893 | ||
2894 | EXIT, TAD SAVPC | |
2895 | DCA PC | |
2896 | TAD SPCCDF | |
2897 | DCA I (PCCDF /RESTORE OLD PC | |
2898 | JMP I FPGO /RETURN TO PDP-8 CODE | |
2899 | SAVPC, 0 | |
2900 | SPCCDF, 0 | |
2901 | ||
2902 | FPXTA, TAD [27 /XR TO AC - NORMALIZE IF FLOATING MODE | |
2903 | DCA ACX | |
2904 | JMS DATCDF | |
2905 | TAD I ADR | |
2906 | CLFAC, DCA ACL | |
2907 | TAD ACL | |
2908 | SPA CLA /SIGN-EXTEND 12-BIT WORD | |
2909 | STA /INTO FAC FRACTION | |
2910 | DCA ACH | |
2911 | NRMFAC, DCA AC1 /CLEAR OVERFLOW WORD | |
2912 | TAD DFLG | |
2913 | SPA SNA CLA /UNLESS WE ARE IN D.P.I. MODE, | |
2914 | JMS I NORMX /NORMALIZE THE FAC | |
2915 | JMP I FPNXT | |
2916 | \f/MISCELLANEOUS JUMP CLASS INSTRUCTIONS | |
2917 | ||
2918 | JSA, TAD ADR | |
2919 | DCA PUTM | |
2920 | TAD DATAF | |
2921 | DCA JSCDF /SET UP LOC TO SAVE PC IN | |
2922 | AC0002 | |
2923 | TAD ADR | |
2924 | DCA ADR /BUMP ADDRESS BY 2 | |
2925 | RTL | |
2926 | RTL | |
2927 | TAD DATAF | |
2928 | DCA DATAF /INCLUDING DATA FIELD | |
2929 | JSAR, TAD I (PCCDF /JSA/JSR COMMON CODE | |
2930 | CLL RTR | |
2931 | RAR | |
2932 | ISZ PC /BUMP PC BEFORE STORING | |
2933 | SKP | |
2934 | IAC /INCLUDING FIELD BITS | |
2935 | TAD (JA-2620 /FORM "JA" INSTRUCTION | |
2936 | JSCDF, HLT | |
2937 | DCA I PUTM | |
2938 | ISZ PUTM | |
2939 | SKP | |
2940 | JMS I (DFBUMP /BUMP TARGET ADDRESS | |
2941 | TAD PC | |
2942 | DCA I PUTM | |
2943 | JMP I (DOJMP /NOW JUMP TO DESTINATION | |
2944 | ||
2945 | JSR, CLA CLL IAC | |
2946 | TAD BASADR | |
2947 | DCA PUTM | |
2948 | RTL | |
2949 | RTL | |
2950 | TAD I (BASCDF /SET JSCDF&PUTM TO BASE PAGE LOC +1 | |
2951 | DCA JSCDF | |
2952 | JMP JSAR | |
2953 | ||
2954 | FPJAC, TAD ACL | |
2955 | DCA ADR | |
2956 | TAD ACH | |
2957 | JMS I MCDF | |
2958 | DCA DATAF | |
2959 | JMP I (DOJMP | |
2960 | ||
2961 | SPCATX, TAD ACL | |
2962 | SKP | |
2963 | FPLDX, JMS I [FETPC | |
2964 | JMS DATCDF | |
2965 | DCA I ADR /SET XR TO NEXT INST WD | |
2966 | JMP I FPNXT | |
2967 | \f/MORE INDEX REGISTER & AC-TO-MEMORY INSTRUCTIONS | |
2968 | ||
2969 | ADDX, JMS I [FETPC | |
2970 | JMS DATCDF | |
2971 | TAD I ADR /ADD NEXT INST WD TO XR | |
2972 | JMP FPLDX+1 | |
2973 | ||
2974 | ATX, TAD DFLG /ATX WORKS DIFFERENTLY IN D.P.I. MODE | |
2975 | SMA SZA CLA | |
2976 | JMP SPCATX | |
2977 | JMS I NORMX /FAC MAY NOT BE NORMALIZED | |
2978 | JMS I [FFIX | |
2979 | TAD ACI | |
2980 | JMP FPLDX+1 | |
2981 | ||
2982 | OPMEM, DCA AD1 /GENERAL AC-TO-MEMORY INTERPRETER | |
2983 | TAD AD1 | |
2984 | DCA AD2 | |
2985 | RDF | |
2986 | CLL RTR | |
2987 | RAR | |
2988 | TAD KLUDGM /FORM FSTA X INSTRUCTION | |
2989 | DCA PUTM | |
2990 | AC2000 | |
2991 | AND INST /TURN OP 5 TO OP 1, | |
2992 | SZA CLA | |
2993 | TAD [3000 / OP 7 TO OP 4. | |
2994 | TAD [3000 | |
2995 | TAD PUTM /STICK IN FIELD BITS | |
2996 | DCA OPM | |
2997 | JMS I [FPGO | |
2998 | KLUDGM | |
2999 | JMP I FPNXT | |
3000 | ||
3001 | KLUDGM, FSTA+LONG | |
3002 | FTEMP /SAVE AC | |
3003 | OPM, 0 | |
3004 | AD1, 0 /PERFORM OP | |
3005 | PUTM, 0 | |
3006 | AD2, 0 /STORE RESULT | |
3007 | FLDA+LONG | |
3008 | FTEMP /RESTORE AC | |
3009 | FEXIT | |
3010 | ||
3011 | NORMX, FFNOR /*K* CHANGED TO EFFNOR IF EAE | |
3012 | PAGE | |
3013 | \f/MAIN INTERPRETER LOOP | |
3014 | ||
3015 | NEGFAC, JMS I [FFNEG | |
3016 | ||
3017 | ICYCLE, CLA | |
3018 | JMS I [FETPC /GET INST | |
3019 | DCA INST | |
3020 | TAD INST | |
3021 | CLL RTL | |
3022 | RTL | |
3023 | SMA /SKIP IF BASEPAGE ADDRESSING | |
3024 | JMP LONGI | |
3025 | AND [7 | |
3026 | TAD BASJMP | |
3027 | DCA OPJMP /SAVE OPCODE CALL ADDRESS | |
3028 | TAD INST /DATA FIELD IS STILL SET UP | |
3029 | SZL /SO IS LINK (WITH INSTRUCTION BIT 3) | |
3030 | JMP BPAGEI /INDIRECT ADDRESSING | |
3031 | CLL RAL | |
3032 | TAD INST /MULTIPLY BASE OFFSET BY 3 | |
3033 | TAD [200 /ELIMINATE ANY | |
3034 | AND (777 /HIGH ORDER BITS | |
3035 | IMFUDJ, CLL /CLL IAC IF D.P. INTEGER MODE | |
3036 | TAD BASADR /ADD IN BASE PAGE ORIGIN | |
3037 | BASCDF, HLT /CDF TO BASE PAGE FIELD | |
3038 | SZL | |
3039 | JMS DFBUMP /BUMP DF IF ADDITION OVERFLOWED | |
3040 | OPJCLL, CLL | |
3041 | OPJMP, HLT /JMP I EXECUTIONROUTINE | |
3042 | ||
3043 | BPAGEI, AND [7 | |
3044 | DCA ADR | |
3045 | TAD ADR | |
3046 | CLL CML RAL | |
3047 | TAD ADR /FORM 3*OFFSET+1 | |
3048 | TAD BASADR | |
3049 | DCA ADR | |
3050 | RTL | |
3051 | RTL | |
3052 | TAD BASCDF /FORM PROPER CDF | |
3053 | DCA ADDRLO | |
3054 | ADDRLO, HLT /EXECUTE IT | |
3055 | TAD I ADR /GET FIELD BITS OF REAL ADDRESS | |
3056 | DCA ADDRHI /FROM 2D WORD OF BASE PAGE LOC | |
3057 | ISZ ADR | |
3058 | SKP | |
3059 | JMS DFBUMP /WATCH FOR FIELD OVERFLOW | |
3060 | TAD I ADR /GET LOW-ORDER ADDRESS FROM 3D WORD | |
3061 | JMP INDEX /NOW GO DO INDEXING (IF ANY) | |
3062 | \f/COME HERE IF BIT 4 OF INSTRUCTION IS OFF | |
3063 | ||
3064 | LONGI, AND [7 | |
3065 | SNL /TEST BIT 3 OF INSTRUCTION | |
3066 | JMP I (SPECAL /SPECIAL INSTRUCTION | |
3067 | TAD BASJMP | |
3068 | DCA OPJMP | |
3069 | TAD INST | |
3070 | DCA ADDRHI /HIGH-ORDER ADDRESS BITS IN INST WD | |
3071 | JMS I [FETPC /NEXT INST WORD CONTAINS LOW-ORDER ADDRESS | |
3072 | INDEX, DCA ADDRLO | |
3073 | TAD INST | |
3074 | AND [70 | |
3075 | SNA /IS XR NUMBER 0? | |
3076 | JMP NOINDX /YES - NO INDEXING | |
3077 | JMS DCDIDX /GET XR VALUE (MAYBE INCREMENTED) | |
3078 | AC7775 | |
3079 | TAD DFLG /GET -3 IF F, -2 IF D, -6 IF E MODE | |
3080 | DCA DCDIDX | |
3081 | TAD ADDRLO | |
3082 | XRADLP, CLL | |
3083 | TAD I T | |
3084 | SZL | |
3085 | ISZ ADDRHI | |
3086 | ISZ DCDIDX /ADD THE XR IN THE PROPER NUMBER OF TIMES | |
3087 | JMP XRADLP | |
3088 | DCA ADDRLO | |
3089 | NOINDX, TAD ADDRHI | |
3090 | JMS I MCDF | |
3091 | DCA ADDRHI /TURN HIGH-ORDER ADDRESS INTO A CDF | |
3092 | ADDRHI, HLT /AND EXECUTE IT | |
3093 | TAD ADDRLO | |
3094 | JMP OPJCLL /GO EXECUTE THE INSTRUCTION | |
3095 | ||
3096 | DFBUMP, 0 /BUMP DATA FIELD | |
3097 | DCA DFTMP /SAVE AC | |
3098 | RDF | |
3099 | TAD (CDF 10 | |
3100 | DCA .+1 | |
3101 | HLT | |
3102 | TAD DFTMP /RESTORE AC | |
3103 | JMP I DFBUMP | |
3104 | DFTMP, 0 | |
3105 | \fDCDIDX, 0 | |
3106 | CLL RTR | |
3107 | RAR | |
3108 | TAD XRBASE /ADD IN BASE ADDRESS OF XR ARRAY | |
3109 | XRCDF, HLT /CDF TO XR ARRAY FIELD | |
3110 | SZL | |
3111 | JMS DFBUMP /OR MAYBE NEXT FIELD | |
3112 | DCA T /SAVE POINTER TO XR | |
3113 | TAD INST | |
3114 | AND DCD100 | |
3115 | SZA CLA /INCREMENT BIT ON? | |
3116 | ISZ I T /YES - BUMP XR | |
3117 | DCD100, 100 /** PROTECTION | |
3118 | JMP I DCDIDX | |
3119 | ||
3120 | BASJMP, JMP I JMPTB1 /JMP I JMPTB2 FOR D.P. MODE | |
3121 | ||
3122 | JMPTB1, FFGET / F MODE (FLOATING POINT) | |
3123 | FFADD | |
3124 | FFSUB | |
3125 | FFDIV | |
3126 | FFMPY | |
3127 | OPMEM /FADDM | |
3128 | FFPUT | |
3129 | OPMEM /FMULM | |
3130 | ||
3131 | DDGET / D MODE ( DOUBLE PRECISION INTEGER) | |
3132 | DDADD | |
3133 | DDSUB | |
3134 | DDDIV | |
3135 | DDMPY | |
3136 | OPMEM /DADDM | |
3137 | DDPUT | |
3138 | OPMEM /DMULM | |
3139 | ||
3140 | EEGET / E MODE ( 6 WD FLOATING POINT) | |
3141 | FFADD | |
3142 | FFSUB | |
3143 | FFDIV | |
3144 | FFMPY | |
3145 | OPMEM | |
3146 | EEPUT | |
3147 | OPMEM | |
3148 | PAGE | |
3149 | \f/MORE I CYCLE | |
3150 | ||
3151 | SPECAL, SNA | |
3152 | JMP XRINST /OPCODE 0 HAS MANY MANSIONS | |
3153 | TAD SPECOP | |
3154 | DCA SPCJMP /GET OPCODE JUMP ADDRESS | |
3155 | JMS I [FETPC | |
3156 | DCA ADR | |
3157 | TAD INST /ALL OF THESE ARE TWO-WORD INSTRUCTIONS | |
3158 | JMS I MCDF /SO FORM THE ADDRESS NOW | |
3159 | DCA DATAF | |
3160 | CDF 0 | |
3161 | TAD INST | |
3162 | SPCJMP, HLT | |
3163 | ||
3164 | XRINST, TAD INST | |
3165 | AND (7770 | |
3166 | CDF 0 | |
3167 | SNA CLA /IF SUB-OPCODE IS ZERO, | |
3168 | JMP OPERAT /DECODE SUB-SUB-OPCODE | |
3169 | TAD INST | |
3170 | AND [7 | |
3171 | CLL | |
3172 | TAD XRBASE | |
3173 | DCA ADR /COMPUTE INDEX REGISTER ADDRESS | |
3174 | RTL | |
3175 | RTL | |
3176 | TAD I (XRCDF | |
3177 | DCA DATAF | |
3178 | XJCOMN, TAD INST | |
3179 | CLL RTR | |
3180 | RAR | |
3181 | AND [77 /GET OPCODE - HIGH ORDER 2 BITS ARE 0 | |
3182 | OXCOMN, TAD (JMP I SP2 | |
3183 | DCA .+1 /EXECUTE APPROPRIATE JUMP | |
3184 | HLT | |
3185 | ||
3186 | OPERAT, TAD INST | |
3187 | CIA | |
3188 | JMP OXCOMN | |
3189 | ||
3190 | SETX, TAD DATAF /SET XR0 LOC | |
3191 | DCA I (XRCDF | |
3192 | TAD ADR | |
3193 | DCA XRBASE | |
3194 | JMP I FPNXT | |
3195 | \f/JUMP DECODER | |
3196 | ||
3197 | JUMPS, AND (100 /INSTRUCTION IN AC | |
3198 | CLL RTR /20 IN AC IF NOT COND. JUMP | |
3199 | SZA /IF NOT COND. JUMP, DECODE FURTHER | |
3200 | JMP XJCOMN | |
3201 | TAD INST | |
3202 | AND [70 | |
3203 | CLL RTR | |
3204 | RAR | |
3205 | TAD (CNDSKT | |
3206 | DCA T /INDEX INTO CONDITIONAL SKIP TABLE | |
3207 | TAD I T | |
3208 | DCA CNDSKP | |
3209 | TAD ACH | |
3210 | SZA | |
3211 | JMP CNDSKP | |
3212 | TAD ACL | |
3213 | SZA CLA /IF HIGH ORDER ZERO, AC MIGHT BE UNNORMALIZED. | |
3214 | IAC /USE LOW ORDER ON 0/NOT 0 BASIS | |
3215 | CNDSKP, HLT /TEST AC | |
3216 | JMP I FPNXT /FAILED - DON'T JUMP | |
3217 | ||
3218 | DOJMP, STA CLL | |
3219 | TAD ADR | |
3220 | DCA PC | |
3221 | SNL | |
3222 | TAD (-10 | |
3223 | TAD DATAF | |
3224 | CDF 0 | |
3225 | DCA I (PCCDF /ADDRESS-1 TO PC | |
3226 | JMP I .+1 | |
3227 | YFJMP, ICYCLE /** CHANGED IF RUNNING UNDER RTS-8 | |
3228 | ||
3229 | JXN, AND [70 /GET XR FIELD | |
3230 | JMS I (DCDIDX /GET XR VALUE WITH INCREMENTING | |
3231 | TAD I T | |
3232 | SNA CLA /ZERO? | |
3233 | JMP I FPNXT /YES | |
3234 | JMP DOJMP /JUMP ON INDEX NON-ZERO, RIGHT? | |
3235 | ||
3236 | CNDSKT, SZA CLA /JEQ | |
3237 | SPA CLA /JGE | |
3238 | SMA SZA CLA /JLE | |
3239 | SKP CLA /JA | |
3240 | SNA CLA /JNE | |
3241 | SMA CLA /JLT | |
3242 | SPA SNA CLA /JGT | |
3243 | JMP TSTALN /JAL | |
3244 | ||
3245 | TSTALN, CLA | |
3246 | TAD ACX | |
3247 | TAD (-27 | |
3248 | SPA SNA CLA | |
3249 | JMP I FPNXT | |
3250 | JMP DOJMP | |
3251 | \f/OPCODE TABLES | |
3252 | ||
3253 | SPECOP, JMP I SPECOP /SPECIAL OPCODE TABLE | |
3254 | JUMPS | |
3255 | JXN | |
3256 | TRAP3I | |
3257 | TRAP4I | |
3258 | TRAP5I | |
3259 | TRAP6I | |
3260 | TRAP7I | |
3261 | ||
3262 | FPJAC | |
3263 | STRTD | |
3264 | STRTF | |
3265 | NRMFAC | |
3266 | NEGFAC | |
3267 | CLFAC | |
3268 | FPAUSE | |
3269 | SP2, EXIT | |
3270 | ALN | |
3271 | ATX | |
3272 | FPXTA | |
3273 | ICYCLE /NOP | |
3274 | STRTE | |
3275 | ICYCLE /UNDEF OP | |
3276 | ICYCLE /" | |
3277 | FPLDX | |
3278 | ADDX | |
3279 | SETX | |
3280 | SETB | |
3281 | JSA | |
3282 | JSR | |
3283 | PAGE | |
3284 | \f/MISCELLANEOUS OPCODE ROUTINES | |
3285 | ||
3286 | TRAP3I, | |
3287 | TRAP4I, AC0002 | |
3288 | TAD DATAF | |
3289 | DCA .+1 /FORM CDF CIF N | |
3290 | HLT /EXECUTE IT | |
3291 | TAD INST | |
3292 | SMA CLA /TRAP4 JMS'S TO ITS TARGET ADDRESS, | |
3293 | JMP I ADR /TRAP3 JMP'S TO IT | |
3294 | JMS I ADR | |
3295 | JMP I FPNXT | |
3296 | ||
3297 | ALN, TAD ACX /ALIGN SIMULATOR | |
3298 | DCA OPX /SAVE EXPONENT IN CASE WE'RE IN D.I. MODE | |
3299 | TAD DFLG | |
3300 | SMA SZA CLA | |
3301 | DCA ACX /ZERO EXP IF D.I. MODE | |
3302 | JMS DATCDF /SET TO XR FIELD | |
3303 | TAD INST | |
3304 | AND [7 | |
3305 | TAD DFLG /IF WE'RE IN FLOATING POINT MODE, | |
3306 | SNA CLA /AND DOING AN "ALN 0", | |
3307 | TAD [27 /ALIGN UNTIL EXPONENT = 23 | |
3308 | SNA | |
3309 | TAD I ADR /OTHERWISE ALIGN UNTIL EXPONENT = XR VALUE | |
3310 | CDF 0 | |
3311 | CIA | |
3312 | TAD ACX | |
3313 | CMA /FORM DIFFERENCE - 1 | |
3314 | SPA /IF EXPONENT IS LARGER THEN DESIRED EXPONENT, | |
3315 | JMP ALNSHL /SHIFT LEFT | |
3316 | JMS I [ACSR /OTHERWISE SHIFT RIGHT | |
3317 | ALNXIT, TAD DFLG | |
3318 | SPA SNA CLA /IF DOUBLE INTEGER MODE, | |
3319 | JMP I FPNXT | |
3320 | TAD OPX /ALIGNMENT LEAVES THE EXPONENT UNCHANGED | |
3321 | DCA ACX | |
3322 | JMP I FPNXT | |
3323 | ALNSHL, DCA T /STORE SHIFT COUNT | |
3324 | SKP /SHIFT LEFT ONE LESS THAN COUNT | |
3325 | JMS I [AL1BMP | |
3326 | ISZ T | |
3327 | JMP .-2 | |
3328 | JMP ALNXIT /GO TO COMMON CODE | |
3329 | \f/ARG FETCH SUBROUTINES AND MODE CHANGE OPERATORS | |
3330 | ||
3331 | DARGET, 0 | |
3332 | DCA ADR | |
3333 | TAD DARGET | |
3334 | DCA ARGET | |
3335 | DCA ACX | |
3336 | JMP ARGET2 /FAKE OUT FLOATING POINT ROUTINE | |
3337 | ||
3338 | ARGET, 0 /SUBROUTINE TO FETCH ARG FOR ADD, SUBT, ETC. | |
3339 | DCA ADR /STORE ADDRESS OF OPERAND | |
3340 | TAD I ADR /PICK UP EXPONENT | |
3341 | ISZ ADR /MOVE POINTER TO HI MANTISSA WD | |
3342 | SKP | |
3343 | JMS I (DFBUMP | |
3344 | ARGET2, DCA OPX | |
3345 | TAD I ADR /PICK IT UP | |
3346 | DCA OPH /STORE | |
3347 | ISZ ADR /MOVE PTR. TO LO MANTISSA WD. | |
3348 | SKP | |
3349 | JMS I (DFBUMP /WATCH THOSE FIELD TRANSITIONS! | |
3350 | TAD I ADR /PICK IT UP | |
3351 | DCA OPL /STORE IT | |
3352 | CDF 0 | |
3353 | JMP I ARGET /RETURN | |
3354 | ||
3355 | STRTE, TAD DFLG /START EXTENDED PRECISION MODE | |
3356 | SPA CLA | |
3357 | JMP .+4 /CLEAR EXTENDED FAC | |
3358 | DCA EAC1 /IF NOT ALREADY IN E MODE | |
3359 | DCA EAC2 | |
3360 | DCA EAC3 | |
3361 | AC7775 | |
3362 | DCA DFLG | |
3363 | JMP DFECMN | |
3364 | ||
3365 | STRTD, CLA IAC /START DOUBLE PRECISION INTEGER MODE | |
3366 | STRTF, DCA DFLG /START FLOATING POINT MODE | |
3367 | TAD DFLG | |
3368 | DFECMN, TAD (CLL | |
3369 | DCA I (IMFUDJ /SET D.P.I FUDGE TO "CLL" OR "CLL IAC" | |
3370 | TAD DFLG | |
3371 | SPA | |
3372 | CMA /CHANGE -3 FOR E MODE TO +2 | |
3373 | CLL RTL | |
3374 | RAL | |
3375 | TAD (JMPTB1&177+5600 | |
3376 | DCA I (BASJMP | |
3377 | JMP I FPNXT | |
3378 | \f/DOUBLE PRECISION INTEGER OPERATORS | |
3379 | ||
3380 | DDSUB, JMS DARGET | |
3381 | JMS I (OPNEG | |
3382 | SKP | |
3383 | DDADD, JMS DARGET | |
3384 | DCA AC1 /CLEAR OVERFLOW JUSTINCASE | |
3385 | JMS I [OADD | |
3386 | JMP I FPNXT | |
3387 | ||
3388 | FFGET, DCA ADR /GET A FLOATING POINT NUMBER | |
3389 | TAD I ADR | |
3390 | DCA ACX /SAVE EXPONENT | |
3391 | ISZ ADR | |
3392 | JMP .+3 /NO FIELD OVERFLOW | |
3393 | JMS I (DFBUMP /BUMP DATA FIELD | |
3394 | DDGET, DCA ADR /SUAVE - ENTRY POINT FOR D.P. INTEGER GET | |
3395 | TAD I ADR | |
3396 | DCA ACH | |
3397 | ISZ ADR | |
3398 | SKP | |
3399 | JMS I (DFBUMP | |
3400 | TAD I ADR | |
3401 | DCA ACL | |
3402 | JMP I FPNXT | |
3403 | ||
3404 | FFPUT, DCA ADR /STORE A FLOATING POINT NUMBER | |
3405 | TAD ACX /GET FAC AND STORE IT | |
3406 | DCA I ADR /AT SPECIFIED ADDRESS | |
3407 | ISZ ADR | |
3408 | JMP .+3 | |
3409 | JMS I (DFBUMP | |
3410 | DDPUT, DCA ADR /ENTRY FOR D.P. INTEGER PUT | |
3411 | TAD ACH | |
3412 | DCA I ADR | |
3413 | ISZ ADR | |
3414 | SKP | |
3415 | JMS I (DFBUMP | |
3416 | TAD ACL | |
3417 | DCA I ADR | |
3418 | JMP I FPNXT | |
3419 | PAGE | |
3420 | \fFPPKG= . /FOR EAE OVERLAY | |
3421 | ||
3422 | /23-BIT FLOATING PT INTERPRETER | |
3423 | /W.J. CLOGHER, MODIFIED BY R.LARY FOR FORTRAN | |
3424 | ||
3425 | LPBUF2, ZBLOCK 16 | |
3426 | LPBUF3 | |
3427 | ||
3428 | AL1BMP, 0 /*K* UTILITY SUBROUTINE - USED BY INTERPRETER | |
3429 | STA | |
3430 | TAD ACX | |
3431 | DCA ACX | |
3432 | JMS I [AL1 | |
3433 | JMP I AL1BMP | |
3434 | ||
3435 | /FLOATING MULTIPLY-DOES 2 24X12 BIT MULTIPLIES | |
3436 | DDMPY, JMS I (DARGET | |
3437 | SKP | |
3438 | FFMPY, JMS I (ARGET /GET OPERAND | |
3439 | JMS MDSET /SET UP FOR MPY-OPX IN AC ON RETN. | |
3440 | TAD ACX /DO EXPONENT ADDITION | |
3441 | DCA ACX /STORE FINAL EXPONENT | |
3442 | DCA MDSET /ZERO TEM STORAGE FOR MPY ROUTINE | |
3443 | DCA AC2 | |
3444 | TAD ACH /IS FAC=0? | |
3445 | SNA CLA | |
3446 | DCA ACX /YES-ZERO EXPONENT | |
3447 | JMS MP24 /NO-MULTIPLY FAC BY LOW ORDER OPR. | |
3448 | TAD OPH /NOW MULTIPLY FAC BY HI ORDER MULTIPLIER | |
3449 | DCA OPL | |
3450 | JMS MP24 | |
3451 | TAD AC2 /STORE RESULT BACK IN FAC | |
3452 | DCA ACL /LOW ORDER | |
3453 | TAD MDSET /HIGH ORDER | |
3454 | DCA ACH | |
3455 | TAD ACH /DO WE NEED TO NORMALIZE? | |
3456 | RAL | |
3457 | SMA CLA | |
3458 | JMS AL1BMP /YES-DO IT FAST | |
3459 | TAD AC1 | |
3460 | SPA CLA /CHECK OVERFLOW WORD | |
3461 | ISZ ACL /HIGH BIT ON - ROUND RESULT | |
3462 | JMP MDONE | |
3463 | ISZ ACH /LOW ORDER OVERFLOWED - INCREMENT HIGH ORDER | |
3464 | TAD ACH | |
3465 | SPA /CHECK FOR OVERFLOW TO 4000 0000 | |
3466 | JMP I (SHR1 /WE HANDLE A SIMILIAR CASE IN FLOATING DIVIDE | |
3467 | CLA | |
3468 | \fMDONE, DCA AC1 /ZERO OVERFLOW WD(DO I NEED THIS???) | |
3469 | ISZ MSIGN /SHOULD RESULT BE NEGATIVE? | |
3470 | SKP /NO | |
3471 | JMS I [FFNEG /YES-NEGATE IT | |
3472 | TAD ACH | |
3473 | SNA CLA /A ZERO AC MEANS A ZERO EXPONENT | |
3474 | DCA ACX | |
3475 | TAD DFLG | |
3476 | SMA SZA CLA /D.P. INTEGER MODE? | |
3477 | TAD ACX /WITH ACX LESS THAN 0? | |
3478 | SNA | |
3479 | JMP I FPNXT /NO - RETURN | |
3480 | CMA | |
3481 | JMS I [ACSR /UN-NORMALIZE RESULT | |
3482 | JMP I FPNXT /RETURN | |
3483 | \f/MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE | |
3484 | /ALSO SHIFTS OPERAND ONE BIT TO THE LEFT. | |
3485 | /EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT | |
3486 | /CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND | |
3487 | /DATA FIELD SET PROPERLY FOR OPERAND. | |
3488 | ||
3489 | MDSET, 0 | |
3490 | CLA CLL CMA RAL /SET SIGN CHECK TO -2 | |
3491 | DCA MSIGN | |
3492 | TAD OPH /IS OPERAND NEGATIVE? | |
3493 | SMA CLA | |
3494 | JMP .+3 /NO | |
3495 | JMS I (OPNEG /YES-NEGATE IT | |
3496 | ISZ MSIGN /BUMP SIGN CHECK | |
3497 | TAD OPL /AND SHIFT OPERAND LEFT ONE BIT | |
3498 | CLL RAL | |
3499 | DCA OPL | |
3500 | TAD OPH | |
3501 | RAL | |
3502 | DCA OPH | |
3503 | DCA AC1 /CLR. OVERFLOW WORF OF FAC | |
3504 | TAD ACH /IS FAC NEGATIVE | |
3505 | SMA CLA | |
3506 | JMP LEV /NO-GO ON | |
3507 | JMS I [FFNEG /YES-NEGATE IT | |
3508 | ISZ MSIGN /BUMP SIGN CHECK | |
3509 | NOP /MAY SKIP | |
3510 | LEV, TAD OPX /EXIT WITH OPERAND EXPONENT IN AC | |
3511 | JMP I MDSET | |
3512 | MSIGN, 0 | |
3513 | \f/24 BIT BY 12 BIT MULTIPLY. MULTIPLIER IS IN OPL | |
3514 | /MULTIPLICAND IS IN ACH AND ACL | |
3515 | /RESULT LEFT IN MDSET,AC2, AND AC1 | |
3516 | ||
3517 | MP24, 0 | |
3518 | TAD (-14 /SET UP 12 BIT COUNTER | |
3519 | DCA OPX | |
3520 | TAD OPL /IS MULTIPLIER=0? | |
3521 | SZA | |
3522 | JMP MPLP1 /NO-GO ON | |
3523 | DCA AC1 /YES-INSURE RESULT=0 | |
3524 | JMP I MP24 /RETURN | |
3525 | MPLP, TAD OPL /SHIFT A BIT OUT OF LOW ORDER | |
3526 | MPLP1, RAR /OF MULTIPLIER AND INTO LINK | |
3527 | DCA OPL | |
3528 | SNL /WAS IT A 1? | |
3529 | JMP MPLP2 /NO - 0 - JUST SHIFT PARTIAL PRODUCT | |
3530 | TAD AC2 /YES-ADD MULTIPLICAND TO PARTIAL PRODUCT | |
3531 | TAD ACL /LOW ORDER | |
3532 | DCA AC2 | |
3533 | CML RAL /*K* NOTE THE "SNL" 5 WORDS BACK! | |
3534 | TAD ACH /HI ORDER | |
3535 | MPLP2, TAD MDSET | |
3536 | RAR /NOW SHIFT PARTIAL PROD. RIGHT 1 BIT | |
3537 | DCA MDSET | |
3538 | TAD AC2 | |
3539 | RAR | |
3540 | DCA AC2 | |
3541 | TAD AC1 | |
3542 | RAR /OVERFLOW TO AC1 | |
3543 | DCA AC1 | |
3544 | ISZ OPX /DONE ALL 12 MULTIPLIER BITS? | |
3545 | JMP MPLP /NO-GO ON | |
3546 | JMP I MP24 /YES-RETURN | |
3547 | PAGE | |
3548 | \f/DIVIDE-BY-ZERO ROUTINE - MUST BE AT BEGINNING OF PAGE | |
3549 | ||
3550 | DBAD, ISZ FATAL /DIVIDE BY 0 NON-FATAL | |
3551 | JMS I ERR /GIVE ERROR MSG | |
3552 | TAD DBAD | |
3553 | DCA ACX /RETURN A VERY LARGE POSITIVE NUMBER | |
3554 | AC2000 | |
3555 | JMP FD | |
3556 | ||
3557 | /FLOATING DIVIDE - USES DIVIDE-AND-CORRECT METHOD | |
3558 | ||
3559 | DDDIV, JMS I (DARGET | |
3560 | SKP | |
3561 | FFDIV, JMS I (ARGET /GET OPERAND | |
3562 | JMS I (MDSET /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. | |
3563 | CMA IAC /NEGATE EXP. OF OPERAND | |
3564 | TAD ACX /ADD EXP OF FAC | |
3565 | DCA ACX /STORE AS FINAL EXPONENT | |
3566 | TAD OPH /NEGATE HI ORDER OP. FOR USE | |
3567 | CLL CMA IAC /AS DIVISOR | |
3568 | DCA OPH | |
3569 | JMS DV24 /CALL DIV.--(ACH+ACL)/OPH | |
3570 | TAD ACL /SAVE QUOT. FOR LATER | |
3571 | DCA AC1 | |
3572 | TAD OPL | |
3573 | SNA CLA | |
3574 | JMP DVL2 /AVOID MULTIPLYING BY 0 | |
3575 | TAD (-15 /SET COUNTER FOR 12 BIT MULTIPLY | |
3576 | DCA DV24 /TO MULTIPLY QUOT. OF DIV. BY | |
3577 | JMP DVLP1 /LOW ORDER OF OPERAND (OPL) | |
3578 | ||
3579 | /DIVIDE ROUTINE - (ACH,ACL)/OPH = ACL REMAINDER REM (AC2=0) | |
3580 | ||
3581 | DV24, 0 | |
3582 | TAD ACH /CHECK THAT DIVISOR IS .GT. DIVIDEND | |
3583 | TAD OPH /DIVISOR IN OPH (NEGATIVE) | |
3584 | SZL CLA /IS IT? | |
3585 | JMP DBAD /NO-DIVIDE OVERFLOW | |
3586 | TAD (-15 /YES-SET UP 12 BIT LOOP | |
3587 | DCA AC2 | |
3588 | JMP DV1 /GO BEGIN DIVIDE | |
3589 | DV2, TAD ACH /CONTINUE SHIFT OF FAC LEFT | |
3590 | RAL | |
3591 | DCA ACH /RESTORE HI ORDER | |
3592 | TAD ACH /NOW SUBTRACT DIVISOR FROM HI ORDER | |
3593 | TAD OPH /DIVIDEND | |
3594 | SZL /GOOD SUBTRACT? | |
3595 | DCA ACH /YES-RESTORE HI DIVIDEND | |
3596 | CLA /NO-DON'T RESTORE--OPH.GT.ACH | |
3597 | DV1, TAD ACL /SHIFT FAC LEFT 1 BIT-ALSO SHIFT | |
3598 | RAL /1 BIT OF QUOT. INTO LOW ORD OF ACL | |
3599 | DCA ACL | |
3600 | ISZ AC2 /DONE 12 BITS OF QUOT? | |
3601 | JMP DV2 /NO-GO ON | |
3602 | JMP I DV24 /YES-RETN W/AC2=0 | |
3603 | \f/DIVIDE ROUTINE CONTINUED | |
3604 | ||
3605 | MP12L, DCA OPL /STORE BACK MULTIPLIET | |
3606 | TAD AC2 /GET PRODUCT SO FAR | |
3607 | SNL /WAS MULTIPLIER BIT A 1? | |
3608 | JMP .+3 /NO-JUST SHIFT THE PARTIAL PRODUCT | |
3609 | CLL /YES-CLEAR LINK AND ADD MULTIPLICAND | |
3610 | TAD ACL /TO PARTIAL PRODUCT | |
3611 | RAR /SHIFT PARTIAL PRODUCT-THIS IS HI ORDER | |
3612 | DCA AC2 /RESULT-STORE BACK | |
3613 | DVLP1, TAD OPL /SHIFT A BIT OUT OF MULTIPLIER | |
3614 | RAR /AND A BIT OR RESLT. INTO IT (LO ORD. PROD.) | |
3615 | ISZ DV24 /DONE ALL BITS? | |
3616 | JMP MP12L /NO-LOOP BACK | |
3617 | CLL CIA /YES-LOW ORDER PROD. OF QUOT. X OPL IN AC | |
3618 | DCA ACL /NEGATE AND STORE | |
3619 | CML RAL /PROPAGATE CARRY | |
3620 | TAD AC2 /NEGATE HI ORDER PRODUCT | |
3621 | STL CIA | |
3622 | TAD ACH /COMPARE WITH REMAINDER OF FIRST DIV. | |
3623 | SZL /WELL? | |
3624 | JMP DVOPS /GREATER THAN REM.-ADJUST QUOT OF 1ST DIV. | |
3625 | DCA ACH /OK - DO (REM - (Q*OPL)) / OPH | |
3626 | DVL3, JMS DV24 /DIVIDE BY OPH (HI ORDER OPERAND) | |
3627 | DVL1, TAD AC1 /GET QUOT. OF FIRST DIV. | |
3628 | SMA /IF HI ORDER BIT SET-MUST SHIFT 1 RIGHT | |
3629 | JMP FD /NO-ITS NORMALIZED-DONE | |
3630 | SHR1, CLL | |
3631 | ISZ ACL /ROUND AND SHIFT RIGHT ONE | |
3632 | SKP | |
3633 | IAC /DOUBLE PRECISION INCREMENT | |
3634 | RAR | |
3635 | DCA ACH /STORE IN FAC | |
3636 | TAD ACL /SHIFT LOW ORDER RIGHT | |
3637 | RAR | |
3638 | DCA ACL /STORE BACK | |
3639 | ISZ ACX /BUMP EXPONENT | |
3640 | NOP | |
3641 | TAD ACH | |
3642 | JMP DVL1+1 /IF FRACT WAS 77777777 WE MUST SHIFT AGAIN | |
3643 | FD, DCA ACH /STORE HIGH ORDER RESULT | |
3644 | JMP I (MDONE /GO LEAVE DIVIDE | |
3645 | ||
3646 | DVL2, DCA ACL /COME HERE IF LOW-ORDER QUO=0 | |
3647 | JMP DVL3 /SAVE SOME TIME | |
3648 | \f/ROUTINE TO ADJUST QUOTINET OF FIRST DIVIDE (MAYBE) WHEN THE | |
3649 | /REMAINDER OF THE FIRST DIVIDE IS LESS THAN QUOT*OPL | |
3650 | ||
3651 | DVOPS, CMA IAC /NEGATE AND STORE REVISED REMAINDER | |
3652 | DCA ACH | |
3653 | CLL | |
3654 | TAD OPH | |
3655 | TAD ACH /WATCH FOR OVERFLOW | |
3656 | SNL | |
3657 | JMP DVOP1 /OVERFLOW-DON'T ADJUST QUOT. OF 1ST DIV. | |
3658 | DCA ACH /NO OVERFLOW-STORE NEW REM. | |
3659 | CMA /SUBTRACT 1 FROM QUOT OF | |
3660 | TAD AC1 /FIRST DIVIDE | |
3661 | DCA AC1 | |
3662 | DVOP1, CLA CLL | |
3663 | TAD ACH /GET HI ORD OF REMAINDER | |
3664 | SNA /IS IT ZERO? | |
3665 | DVOP2, DCA ACL /YES-MAKE WHOLE THING ZERO | |
3666 | DCA ACH | |
3667 | JMS DV24 /DIVIDE EXTENDED REM. BY HI DIVISOR | |
3668 | TAD ACL /NEGATE THE RESULT | |
3669 | CLL CMA IAC | |
3670 | DCA ACL | |
3671 | SNL /IF QUOT. IS NON-ZERO, SUBTRACT | |
3672 | CMA /ONE FROM HIGH ORDER QUOT. | |
3673 | JMP DVL1 /GO TO IT | |
3674 | ||
3675 | LPBUF3, ZBLOCK 12 | |
3676 | LPBUF4 | |
3677 | PAGE | |
3678 | \f/"OPNEG" MUST BE AT 0 ON PAGE | |
3679 | ||
3680 | OPNEG, 0 /ROUTINE TO NEGATE OPERAND | |
3681 | TAD OPL /GET LOW ORDER | |
3682 | CLL CIA /NEGATE AND STORE BACK | |
3683 | DCA OPL | |
3684 | CML RAL /PROPAGATE CARRY | |
3685 | TAD OPH /GET HI ORDER | |
3686 | CLL CIA /NEGATE AND STORE BACK | |
3687 | DCA OPH | |
3688 | JMP I OPNEG | |
3689 | / | |
3690 | /FLOATING SUBTRACT AND ADD | |
3691 | / | |
3692 | FFSUB, JMS I (ARGET /PICK UO THE OP. | |
3693 | JMS OPNEG /NEGATE OPERAND | |
3694 | SKP | |
3695 | FFADD, JMS I (ARGET /PICK UP OPERAND | |
3696 | TAD OPH /IS OPERAND = 0 | |
3697 | SNA CLA | |
3698 | JMP I FPNXT /YES-DONE | |
3699 | TAD ACH /NO-IS FAC=0? | |
3700 | SNA CLA | |
3701 | JMP CLROFL /CLEAR OUT THE OVERFLOW BITS | |
3702 | TAD ACX /NO-DO EXPONENT CALCULATION | |
3703 | CLL CIA | |
3704 | TAD OPX | |
3705 | SMA SZA /WHICH EXP. GREATER? | |
3706 | JMP FACR /OPERANDS-SHIFT FAC | |
3707 | CIA /FAC'S-SHIFT OPERAND=DIFFRNCE+1 | |
3708 | TAD (-30 | |
3709 | SMA /TEST FOR INSIGNIFICANCE | |
3710 | JMP OPINSG /YES - ANSWER IS FAC | |
3711 | TAD (30 | |
3712 | JMS OPSR | |
3713 | JMS I [ACSR /SHIFT FAC ONE PLACE RIGHT | |
3714 | DOADD, TAD OPX /SET EXPONENT OF RESULT | |
3715 | DCA ACX | |
3716 | JMS I [OADD /DO THE ADDITION | |
3717 | JMS FFNOR /NORMALIZE RESULT | |
3718 | JMP I FPNXT /RETURN | |
3719 | FACR, TAD (-30 | |
3720 | SMA /TEST FOR INSIGNIFICANCE | |
3721 | JMP ACINSG /YES - ANSWER IS OPR | |
3722 | TAD (30 | |
3723 | JMS I [ACSR /SHIFT FAC = DIFF.+1 | |
3724 | JMS OPSR /SHIFT OPR. 1 PLACE | |
3725 | JMP DOADD /DO ADDITION | |
3726 | ||
3727 | OPINSG, CLA | |
3728 | JMP I FPNXT | |
3729 | \f/OPERAND SHIFT RIGHT-ENTER WITH POSITIVE COUNT-1 IN AC | |
3730 | ||
3731 | OPSR, 0 | |
3732 | CMA /- (COUNT+1) TO SHIFT COUNTER | |
3733 | DCA AC0 | |
3734 | LOP2, TAD OPH /GET SIGN BIT | |
3735 | CLL /TO LINK | |
3736 | SPA | |
3737 | CML /WITH HI MANTISSA IN AC | |
3738 | RAR /SHIFT IT RIGHT, PROPAGATING SIGN | |
3739 | DCA OPH /STORE BACK | |
3740 | TAD OPL | |
3741 | RAR | |
3742 | DCA OPL /STORE LO ORDER BACK | |
3743 | ISZ OPX /INCREMENT EXPONENT | |
3744 | NOP | |
3745 | ISZ AC0 /DONE ALL SHIFTS? | |
3746 | JMP LOP2 /NO-LOOP | |
3747 | RAR /SAVE 1 BIT OF OVERFLOW | |
3748 | DCA AC2 /IN AC2 | |
3749 | JMP I OPSR /YES-RETN. | |
3750 | ||
3751 | FFNOR, 0 /ROUTINE TO NORMALIZE THE FAC | |
3752 | TAD ACH /GET THE HI ORDER MANTISSA | |
3753 | SNA /ZERO? | |
3754 | TAD ACL /YES-HOW ABOUT LOW? | |
3755 | SNA | |
3756 | TAD AC1 /LOW=0, IS OVRFLO BIT ON? | |
3757 | SNA CLA | |
3758 | JMP ZEXP /#=0-ZERO EXPONENT | |
3759 | NORMLP, CLA CLL CML RTR /NOT 0-MAKE A 2000 IN AC | |
3760 | TAD ACH /ADD HI ORDER MANTISSA | |
3761 | SZA /HI ORDER = 6000 | |
3762 | JMP .+3 /NO-CHECK LEFT MOST DIGIT | |
3763 | TAD ACL /YES-6000 OK IF LOW=0 | |
3764 | SZA CLA | |
3765 | SPA CLA /2,3,4,5,ARE LEGAL LEFT MOST DIGS. | |
3766 | JMP FFNORR /FOR NORMALIZED #-(+2000=4,5,6,7) | |
3767 | JMS I [AL1BMP /SHIFT AC LEFT AND BUMP ACX DOWN | |
3768 | JMP NORMLP /GO BACK AND SEE IF NORMALIZED | |
3769 | ZEXP, DCA ACX | |
3770 | FFNORR, DCA AC1 /DONE W/NORMALIZE - CLEAR AC1 | |
3771 | JMP I FFNOR /RETURN | |
3772 | ||
3773 | ACINSG, CLA /COME HERE IF AC IS INSIGNIFICANT ON ADDITION | |
3774 | DCA ACH | |
3775 | DCA ACL | |
3776 | JMP DOADD-1 /FAKE AN ADD WITH OPR=0 | |
3777 | ||
3778 | LPBUF4, ZBLOCK 40 | |
3779 | LPBUFE | |
3780 | CLROFL, DCA AC1 /CLEAR THE FLOATING AC OVERFLOW WORD | |
3781 | DCA AC2 /CLEAR THE OPERAND OVERFLOW WORD | |
3782 | JMP DOADD /FAC=0; DO THE ADD | |
3783 | PAGE | |
3784 | \f/PAGE 7400 UNUSED RIGHT NOW | |
3785 | ||
3786 | LPBUFE, ZBLOCK 177 | |
3787 | LPBUFR | |
3788 | FIELD 1 | |
3789 | \f |