1 /IOH SUBROUTINE OS8 FORTRAN II LIBRARY
11 /COPYRIGHT (C) 1974,1977 BY DIGITAL EQUIPMENT CORPORATION
22 /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
23 /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
24 /CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
25 /FOR ANY ERRORS THAT MAY APPEAR IN THIS MANUAL.
27 /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
28 /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
29 /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
30 /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
32 /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
33 /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
47 / INPUT OUTPUT CONVERSION SUBROUTINE
48 / FOR 8K ALICS-FORTRAN SYSTEM
49 / VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
51 ABSYM SACH 23 /SAVE FPAC FOR MANIPULATION OF AC
54 ABSYM N2 175 /LAST ACCUMULATED NUMBER
62 / THE FOLLOWING IS NECESSARY BECAUSE CERTAIN SUBROUTINES SKIP
79 ERR2, ISZ WHI /SEE IF THIS WAS I FORMAT OR THE EXPONENT
80 ERR3, ISZ ERRNO /IN E FORMAT
83 ERR1, ISZ DV /ERR1 IS ALWAYS FATAL
86 SNA CLA /WAS THIS AN INPUT ERROR FROM THE TELETYPE?
87 CLA CLL CML RAR /YES - NON-FATAL
90 TAD ERRNO /IOH ERROR NUMBER
91 TAD (2461 /MAKE INTO BCD
92 DCA SW /TO ERROR COMMENT
96 JMP RETRY /DO ENTIRE READ STATEMENT OVER
97 DV, 0 /SAVE DEVICE CODE
98 CS, A2 /INITIAL PUSH POINTER
107 10 /ENTRY POINT FOR READ
108 RETRY, TAD READ /SNEAK IN
111 DCA WRITE# /SAVE SECOND RETURN WORD
115 SW, 0 /LEFT OR RIGHT HALF OF FORMAT
118 CLA IAC /INITIALIZE SWITCH
120 DCA CH /CLEAR CHARACTER
121 DCA ERRNO /ZERO ERROR NUMBER IN CASE ERROR RESTART
130 TADI 7 /PICK UP DEVICE NUMBER
131 CLL RTR /ROTATE IT INTO BITS 0-3
135 TAD CS /INITIALIZE PUSH STACK
141 CLA IAC /SET UP "SW" TO START FORMAT
142 DCA SW /FROM SECOND CHARACTER (FIRST IS LPAREN)
143 DCA BA /ZAP END-OF-LINE SWITCH
144 TAD PENTER /FAKE RE-ENTRY TO SET UP FIRST LPAREN
145 DCA GLST /ON PUSHDOWN STACK
154 TAD FPNT /FORM ADDRESS IN AC AND LEFT/RIGHT
155 DCA 7 /SWITCH IN LINK
171 SV, BLOCK 3 /FLOATING POINT TEMPORARY
176 \f PAGE /EXPERIMENTAL
177 RETN, DCA SACH /SET SACH TO 0
178 RTUR, JMS GFRM /GET NEXT CHAR IN FORMAT
180 JMS CHTYPE /CLASSIFY FORMAT CHARACTER
191 JMS NU /GET THE ACCUMULATED NUMBER
193 DCA N1 /AND SAVE COUNT FOR ALL CONVERSIONS
196 TAD (7770 /THIS TESTS IF CH IS AN ,X, OR ,H,
198 CM, JMS PR /IT WAS , PROCESS IT
199 JMP RETN /NOT X OR H, KILL NUMBER AND TRY AGAIN
202 SL, JMS PR /GO PROCESS THE PREVIOUS ITEM (IF ANY)
205 QT, JMS PR /PROCESS PREVIOUS ITEM, IF ANY
211 JMS PRINT /PRINT CHAR
213 DG, JMS DGT /ACCUMULATE DIGIT INTO SACH
214 JMP RTUR /TRY ANOTHER CHARACTER
215 LP, ISZ PUSH /LEFT PAREN
216 CLA CMA /COUNT NESTING DEPTH, NEGATIVE
219 TAD SW /PICK UP THE FORMAT POINTER
220 DCA I PUSH /CRAM IT INTO THE LIST
222 JMS NU /THERE MAY BE AN ACCUMULATED NUMBER
225 CLA CLL CML RTL /HERE WE SEE IF THIS IS A POSSIBLE
226 TAD NPAR /RESTART POINT
227 SPA CLA /IF FIRST SAVE SW IN S1
228 JMP RETN /NOPE- FORGET IT
229 TAD SW /YES--FIRST CRAM FORMAT---
230 DCA S1 /---INTO SAVE1
231 TAD I PUSH /AND THAT STUFF IN THE LIST---
232 DCA S2 /---GOES INTO SAVE 2
233 JMP RETN /READY FOR ANYTHING, HERE WE GO
234 PUSH, 0 /PARENTHESIS PUSHDOWN LIST POINTER
236 RPAR, JMS PR /PROCESS PREVIOUS ITEM, IF ANY
240 TAD PUSH /DELETE THIS ITEM FORM THE LIST
241 DCA PUSH /PUSH = PUSH-2
242 ISZ NPAR /NPAR = NPAR +1 ]-1[ SINCE MINUS COUNT
244 JMS WH /THIS PAREN WAS THE BALANCING PAREN
245 TAD S1 /GET THE FORMAT POINTER OF THE--
246 DCA SW /RESTART POINT AND CRAM IT
247 TAD S2 /GET SWITCH AND THE COUNT
251 TAD SW /TEST TO SEE IF SW IS ORIGINAL POINTER
253 JMP L2 /YES - FAKE A RESTART
254 ISZ PUSH /NO - PUSH ORIGINAL POINTER
255 CLA IAC /SINCE WE ARE RETURNING TO DEPTH 2
258 CLA CMA /SET COUNT = 1, SWITCH = 1
261 L2, DCA NPAR /PARNRN = -1
264 TR, CLA CMA /GET OUT THE FORMAT POINTER--
268 DCA SW /HAA-- IT IS NOW RESTORED
270 N3, 0 /W FOR E AND F CONVER
271 PER, JMS NU /GOT A PERIOD, MUST BE OR F TYPE
275 S2, 0 /SAVE THE COUNT AND SWITCH
277 \f PAGE /EXPERIMENTAL
279 EX, JMS GLST /THIS IS E FORMAT CONVERSION
280 EE, JMS NR /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1]
282 DCA GLST /STORE C AWAY IN A SAFE PLACE
285 DCA EFLG /SET "E FORMAT FAKEOUT" FLAG
287 JMP FFAKE /FAKE OUT "F" FORMAT TO PRINT DIGITS
288 PRNTE, TAD (5 /PUT OUT THE E
292 / NOW PRINT 'C' DIGITS UNDER I3 FORMAT
297 JMS PRINT /PRINT A MINUS OR PLUS
306 CALL 0,IREM /IREM NEEDS AN ARGUMENT TO IGNORE
310 JMS PRINT /PRINT SECOND DIGIT
311 JMP EX /DONE, DO NEXT
314 JMS GLST /THIS IS F FORMAT CONVERSION
315 FF, JMS NR /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1]
317 TAD C /C CONTAINS NUMBER OF MULTS TO RANGE NUMBER
319 CLA CMA /0 MULTS NEEDED OR ALREADY THERE
320 FFAKE, TAD N3 /NUM3 IS THE FIELD WIDTH
321 CIA /MINUS SPACE FOR DADP+DP
323 JMS SA /PUT OUT REQUIRED BLANKS + SIGN
326 JMP PRZRO /NO LEADING DIGIT - PRINT A ZERO FOR LOOKS
331 TAD C /GET MULTIPLY COUNT
334 CMA /THEY WERE MULTIPLIES, 0 TO N OF THEM
336 TAD N2 /DIGITS AFTER DEC POINT, DADP
339 JMP PASA /TEST FOR 0 MULTIPLIES
340 RETR, TAD (60 /PUT OUT A ZERO
341 JMS PRINT /ALL MULTIPLIES REPRESENTED
342 PASA, ISZ CRX /NO, TRY RUN OFF FIELD
345 ISZ NR /ALL WIDTH ACCOUNTED FOR%
346 JMP RETR /NO, TRY NEXT POSITION
349 PASS, TAD C /YES, GET MULT COUNT
353 TAD N2 /N2-MULT COUNT
354 SMA SZA /IS MULT COUNT .GE. N2?
355 JMS DT /NO - PRINT REMAINING DIGITS
356 ISZ EFLG /WERE WE FAKED OUT BY "E" FORMAT?
358 JMP PRNTE /YES - GO PRINT EXPONENT
362 JMP PRDCPT /GO BACK TO PRINT THE DECIMAL POINT
366 SMA /THIS IS -(NUM OF BLANKS)
367 JMP AS3 /POSITIVE, NUMBER TOO BIG FOR FIELD
370 RETC, JMS PRINT /HERE WE PUT OUT THAT MANY BLANKS
376 SNA CLA /IS SIGN MINUS?
377 JMP I SA /EVIDENTLY NOT
379 JMS PRINT /PUT OUT A MINUS SIGN
382 \f PAGE /EXPERIMENTAL
383 FN, TAD N3 /GET WIDTH, INPUT FOR E OR F FORMAT
389 DCA D2 /-1 TO DECIMAL POINT SWITCH
393 ISZ CR /INDEX TO SEE IF WIDTH EXCEEDED
395 JMP FP /GET AN INPUT CHARACTER AND TEST IT
398 JMS CHTYPE /CLASSIFY INPUT CHAR
410 CALL 1,STO /SAVE FLOATING POINT ACCUMULATOR
413 CALL 0,FLOT /FLOAT NEW DIGIT
416 INC D1 /COUNT OF DIGITS
418 PUNT, ISZ D2 /TST DP SWITCH
419 JMPI PERR3 /***** TWO DECIMAL POINTS *****
423 FP, DCA IS /-1 TO IS IF E, 0 TO IS IF END OF FIELD
424 ISZ D2 /TEST DP SWITCH
425 JMP FA /ONE HAS OCCURRED
426 TAD N2 /ONE HAS NOT OCCURRED, GET NDP
428 FA, TAD D1 /COUNT OF DIGITS AFTER EXPLICIT DP
430 JMS DH /DIVIDE FPAC BY TEN COUNT TIMES
431 TAD ACH /IF ACH=0,DON'T CHK. SIGN
433 JMP ZR /ZERO-DON'T CHECK
435 TAD (4000 /SET SIGN BIT
437 ZR, ISZ IS /DID WE GET AN "E"?
438 JMP VZA /NO - STORE RESULT AND GET OUT
439 JMP VQ /YES - FAKE INTEGER ROUTINE TO ACCEPT EXPONENT
445 PRO2, CMA /GOT EXPONENT - MAKE IT NEGATIVE
446 ISZ SN /WHAT WAS ITS ORIGINAL SIGN?
447 JMP VZB /NEGATIVE - DIVIDE BY 10^EXP
452 VZD, ISZ D1 /INDEX COUNT
456 VZA, CALL 1,ISTO /STORE IN PLACE
459 \f PAGE /EXPERIMENTAL
460 XX, JMS MR /TEST FOR MORE
461 TAD IO /TEST FOR INPUT-OUTPUT
463 JMP XX1 /INPUT, PSEUDO-JUMP
464 TAD (40 /OUTPUT A BLANK
467 XX1, JMS GCHR /IGNORE SPACES ON INPUT
471 HH, JMS MR /THE H FIELD PROCESSOR
472 JMS GFRM /SAME AS XXX, BUT PRINT NEXT
473 JMS PRINT /----- FORMAT CHARACTER
479 TAD (100 /CONVERT 6-BIT TO 8-BIT
481 TAD DV /ADD ON DEVICE NUMBER IN BITS 0-3
486 JMS EJ /END THE RECORD
488 SNA CLA /TEST PARAMETER FOR 0
489 JMS GLST /RETURN TO MAIN PROGRAM ON 0 PAR
490 JMP I WH /MORE AGRUMENTS RETURN
492 EJ, 0 /ROUTINE TO END RECORD
494 SZA CLA /INPUT OR OUTPUT?
499 JMP BG /CARRIAGE RETURN SEEN - GOODBYE
500 JMS GCHR /GET A CHARACTER
501 JMP E2 /KEEP LOOKING FOR CR
504 E1, TAD (7715 /7715 TRANSLATES TO 215
507 JMS PRINT /PRINT CR-LF
510 BA, 0 /THIS IS THE END OF LINE SWITCH
511 BH, ISZ BA /ENTRY TO LOOK FOR AN END OF LINE
513 AND (77 /KEEP THIS - BL IS REFERENCED BY GCHR
516 GCHR, 0 /GET AN INPUT STRING CHARACTER
518 TAD BA /GET EOR SWITCH
520 JMP BL /IS EOR, RETURN BLANK
521 CLA CLL CML RTR /****** IF # OF DEVICES IS CHANGED,
522 TAD DV /THIS SHOULD BE CHANGED TOO *****
523 CALL 0,GENIO /CALL GENIO WITH OFFSET DEVICE NUMBER
524 AND (177 /STRIP PARITY
526 SNA /CARRIAGE RETURN?
530 TAD (100 /IS CHAR IN RANGE 237<CHAR<340?
533 JMP BL /CONVERT TO SIXBIT AND RETURN
534 \f PAGE /EXPERIMENTAL
535 / GET F.P. NUMBER INTO THE RANGE .1 .LE. N .L. 1.0
537 JMSKP BB /CHECK DIRECTION OF I/O
539 CALL 1,IFAD /OUTPUT - LOAD NUMBER INTO FLOATING AC
541 DCA SN /CLEAR THESE LOCS
545 JMP NREX /NUMBER IS ZERO
546 SMA /IS IT A MINUS F P NUMBER
548 TAD (4000 /YES-- MAKE IT POSITIVE
551 RETM, CLA /MULTIPLY BY 10 UNTIL NR .GT. (1.0)
555 JMP TB /GOT IT IT IS .GE.1
559 JMP RETM /GO TRY TO DO IT AGAIN
560 TB, JMS SE /NOTE SE ' XR-1
564 DCA ACH /200400000000=.50000 IN AC
567 SNA CLA /IS IT E FORMAT?
568 TAD C /NO - COUNT # OF MULTS NEEDED
572 CMA /NUMBER OF THIMES TO DIVIDE .5 BY 10 TO RND
573 JMS DH /DO THE DIVIDES
576 JMS SE /REDUCE TO NORMAL RANGE AGAIN
582 JMP ZP /NUMBER IS ? 1/2
584 CLL RAR /WE ARE GETTING EXP TO 200
604 C, 0 /COUNTER FOR DEC. EXP.
605 SE, 0 /DIVIDE BY 10 UNTIL N < 1.0
606 XR, TAD ACH /TEST NUMBER FOR .GE. 1
609 JMP I SE /NUMBER IS IN RANGE, RETURN
612 CLA CMA /REDUCE COUNT
616 \f PAGE /EXPERIMENTAL
617 GLST, 0 /GET NEXT ARGUMENT ROUTINE
618 CALL 0,CLEAR /CLEAR FLOATING AC
619 ISZ IOHCNT /ARE WE IN AN ARRAY I/O LOOP?
620 JMP ARMORE /YES - GET NEXT ELEMENT
622 RETRN IOH /RETURN TO USERS PROGRAM FOR MORE DATA
624 TAD IOHINC /BUMP ARGUMENT POINTER BY ELEMENT LENGTH
625 JMP IOHBAK /RESUME I/O CONVERSIONS WITH UPDATED ARGUMT
630 SZA CLA /IS THIS A SCALAR OR AN ARRAY CALL?
631 JMP IOHAR /AN ARRAY CALL
633 IOGTAR, DCA IOHCNT /SET UP ARGUMENT COUNT FOR THIS CALL
636 IOH1, NOP /SET DATA FIELD TO ARGUMENT LIST
642 JMP I GLST /RETURN TO I/O CONVERSION
645 AND I IOH /GET TYPE OF ARRAY
647 CML RAL /FORM A 1 OR A 3, DEPENDING ON ARRAY TYPE
650 ANDI 7 /GET THE ELEMENT COUNT
653 JMP IOGTAR /SAVE IT AND GET ARRAY POINTER
657 CHTYPE, 0 /SUBROUTINE TO CLASSIFY CHARACTERS
663 SZL /IS THE CHARACTER NUMERIC?
664 JMP JMPOUT /YES - TAKE FIRST EXIT
669 SNA /CHARACTER LIST EXHAUSTED?
670 JMP JMPOTX /YES - TAKE LAST EXIT WITH CHAR IN AC
673 JMP JMPOUT /YES - TAKE EXIT WITH AC=0
675 JMP CHLOOP /NO MATCH - GO ON TO NEXT CHAR
685 DCA CHCH /STORE COUNT
686 RETT, JMS LS /LEFT SHIFT 1
687 TAD ACL /SAVE THE FPAC
695 DCA ACH /TRIM AC TO 28 BITS
698 TAD ACL /ADD THE DSAVE TO THE ACC
710 CLL RAR /ROTATE 3 RIGHT
714 JMS PRINT /DUMP IT AND SEE IF ANY MORE
715 ISZ CHCH /LOOP ON COUNT
719 LS, 0 /LEFT SHIFT THE FPAC 1
730 \f PAGE /EXPERIMENTAL
732 TAD SACH /GET THE LAST NUMBER ACCUMULATED
736 JMP I PR /NOTHING TO DO
738 JMS CHTYPE /CLASSIFY CH
739 ERR1 /DIGIT IS ILLEGAL
749 ISZ N1 /SEE IF IT GOES TO ZERO
751 DCA CH /NO MORE FIELDS, FIRST WIPE CHAR
752 JMP I PR /GO BACK TO FORMAT SCANNER
753 NU, 0 /ROUTINE TO FETCH THE ACCUM NUMB
755 SNA /IF IT IS ZERO, SET IT TO 1
756 CLA IAC /IT IS AND WE DO
762 JMS WH /END RECORD AND RETURN TO USERS PROGRAM
763 TAD IO /TEST IN OUT SWITCH
773 AS, JMS GADR /GET CHARACTER ADDRESS
780 ASNORT, AND (77 /MASK 6 BITS
783 JMP AS /LOOP FOR CHARACTER COUNT
784 JMP AX /GET NEXT ARGUMENT(IF ANY)
787 DCA DH /GET AND SAVE INPUT CHAR
788 JMS GADR /GET CHARACTER POINTER
791 JMP ARNORT /RIGHT HALF
798 TAD (7740 /CANCEL BLANK CHAR
804 GADR, 0 /SUBR TO COMPUTE CHARACTER ADDR FOR "A" FMT
810 TAD ARGUMT# /AC=WORD POINTER, LINK=LEFT/RIGHT FLAG
812 AS1, NOP /SET UP DATA FIELD OF ARGUMENT
817 DCA CX /DIVIDE FPAC BY TEN CX TIMES
824 AS3, CLA /PRINT ASTERISKS FOR WHOLE FIELD SIZE
825 TAD N3 /GET FIELD SIZE, E OR F
829 QQA, TAD (52 /PRINT CX ASTERISKS
831 QQ, ISZ CX /INDEX COUNT
833 JMS GLST /TEST FOR MORE
834 JMP PR2 /RETURN TO FORMAT PROCESSOR, SAME TYPE
835 \f PAGE /EXPERIMENTAL
836 IN, TAD N2 /INTEGER INPUT, GET WIDTH OF FIELD
837 CMA /1,S COMP TO COUNTER, CR
840 VQ, DCA WHI /-1 TO NUMBER ACCUMULATED
844 RRS, ISZ CR /HAS WHOLE NUMBER BEEN ACCUMULATED
849 JMS CHTYPE /CLASSIFY CHARACTER
855 DIGIT, JMS DGT /ACCUMULATE DIGIT INTO SACH
856 JMP RRS /GET NEXT DIGIT
857 PRO, TAD SACH /WE HAVE AN INTEGER ...
865 JMS GLST /INTEGER CONVERSION
866 II, JMSKP BB /TEST MORE AND NON ZERO CURRENT LIST ITEM
874 SMA /SET SN 0 FOR PLUS, 1 FOR MINUS
875 JMP XZ /PLACE MAGNITUDE IN 20
882 CALL 0,IREM /IREM NEEDS AN ARGUMENT TO IGNORE
887 DCA I SACL /SAVE REMAINDER
889 TAD SACL /SACL=SACL-1
892 TAD SACH /AND CHECK NUM FOR 0
896 DCA N3 /IN CASE OF OVERFLOW
900 TAD (4 /COMPUTE NUMBER OF LEADING BLANKS
901 JMS SA /PRINT LEADING BLANKS AND SIGN
902 ID, INC SACL /POINT TO DIGIT TO PRINT NEXT
907 JMS PRINT /NOPE - PRINT THE DIGIT