/ /IOH.NW - PAGE 1 /COPYRIGHT 1968, DIGIATAL EQUIPMENT CORP., / MAYNARD, MASS. / VERSION IOH.V08 (FEBRUARY 15, 1969) / INPUT OUTPUT CONVERSION SUBROUTINE / FOR 8K ALICS-FORTRAN SYSTEM / / MODIFICATION FORMATFREE INPUT / G-FORMAT LIKE E-OR-F-FORMAT / ONLY DADP ARE SIGNIFICANT / J-FORMAT LIKE I-FORMAT / TABS ON INPUT ARE CONVERTED / TO BLANKS. TERMINATING CHARS ARE / BLANK OR CARRIAGE/RETURN.TRAILING / BLANKS AND CARRIAGE/RETURNS ARE / IGNORED. NO REPETITION SPECIFICA- / TION OR FIELD WIDTH ARE NEEDED. / WARNING!!!!!! / DO NOT USE WITH G OR J-FORMAT / OTHER FORMATS THAN SINGLE QUOTES / 23.11.71 ABSYM SACH 23 /SAVE FPAC FOR ABSYM SACM 24 /MANIPULATION OF AC ABSYM SACL 25 ABSYM N2 175 /LAST ACCUMULATED NUMBER ABSYM ARGUMT 176 DUMMY ARGUMT DUMMY FPNT ENTRY READ ENTRY WRITE ENTRY IOH /THE FOLLOWING IS NECESSARY BECAUSE CERTAIN /SUBROUTINES SKIP OPDEF TADI 1400 OPDEF DCAI 3400 OPDEF ANDI 0400 OPDEF JMPI 5400 OPDEF JMSI 4400 OPDEF ISZI 2400 SKPDF JMSKP 4000 LAP A2, BLOCK 14 / /IOH.NW - PAGE 2-1 / IOH ERROR ROUTINES ERRNO, BLOCK 1 ERR2, ISZ WHI /SEE IF THIS WAS I FORMAT /OR THE EXPONENT ERR3, ISZ ERRNO /IN E FORMAT ISZ ERRNO SKP ERR1, ISZ DV /ERR1 IS ALWAYS FATAL CLA TAD DV SNA CLA /WAS THIS AN INPUT ERROR /FROM THE TELETYPE? CLA CLL CML RAR /YES - NON-FATAL TAD (615 DCA IO TAD ERRNO /IOH ERROR NUMBER TAD (2461 /MAKE INTO BCD DCA SW /TO ERROR COMMENT CALL 1,ERROR ARG IO JMP RETRY /DO ENTIRE READ /STATEMENT OVER DV, 0 /SAVE DEVICE CODE CS, A2 /INITIAL PUSH POINTER PARN, 0 NOP /CDF N TADI WRITE# INC WRITE# JMP I PARN CH, 0 /FORMAT FIELD TYPE CHAR TW, 12 READ, BLOCK 2 /ENTRY POINT FOR READ RETRY, TAD READ /SNEAK IN DCA WRITE TAD READ# DCA WRITE# /SAVE SECOND RETURN WORD JMP ET / /IOH.NW - PAGE 2-2 CPAGE 4 IO, 0 /0=INPUT, 1=OUTPUT SW, 0 /LEFT OR RIGHT HALF OF /FORMAT WRITE, BLOCK 2 /ENTRY POINT CLA IAC /INITIALIZE SWITCH ET, DCA IO DCA CH /CLEAR CHARACTER DCA ERRNO /ZERO ERROR NUMBER IN /CASE ERROR RESTART TAD WRITE DCA PARN# JMS PARN DCA DEVNO1 JMS PARN DCA 7 DEVNO1, NOP /CDF N CLA CMA TADI 7 /PICK UP DEVICE NUMBER CLL RTR /ROTATE IT INTO BITS 0-3 RTR RAR DCA DV TAD CS /INITIALIZE PUSH STACK DCA PUSH JMS PARN DCA FPNT01 JMS PARN DCA FPNT CLA IAC /SET UP "SW" TO START DCA SW /FORMAT FROM SECOND CHAR /(FIRST IS LPAREN) DCA BA /ZAP END-OF-LINE SWITCH TAD PENTER /FAKE RE-ENTRY TO SET UP DCA GLST /1.LPAR ON PUSHDOWN STCK RETRN WRITE PENTER, FENTER FPNT, 0 /FORMAT POINTER / /IOH.NW - PAGE 2-3 /GET NEXT CHARACTER IN FORMAT GFRM, 0 TAD SW INC SW CLL RAR TAD FPNT /FORM ADDRESS IN AC AND DCA 7 /LEFT/RGHT SWTCH IN LINK FPNT01, NOP /CDF N TADI 7 SZL /LEFT OR RIGHT? JMP HR RTR RTR RTR HR, AND (77 JMP I GFRM CPAGE 5 0 /I1000 0 /I100 0 /I10 I1, 0 /I1 4000 SV, BLOCK 3 /FLOATING POINT TEMPORARY CPAGE 3 TN, 2045 /10.0 0 0 PAGE /EXPERIMENTAL /IOH.NW - PAGE 3-1 RETN, DCA SACH /SET SACH TO 0 RTUR, JMS GFRM /GET NEXT CHAR IN FORMAT CPAGE 24 JMS CHTYPE /CLASSIFY FORMAT CHAR. DG /DIGIT EXIT -57; SL -56; PER -54; CM -51; RPAR -50; LP -47; QT -40; RTUR 0; SVCHR PUSH, 0 /PARENTHESIS PUSHDOWN /LIST POINTER N1, 0 /FIELD REPETITION COUNT N3, 0 /W FOR E AND F CONVER S1, 0 S2, 0 /SVE THE COUNT AND SWTCH NPAR, 0 /NESTING DEPTH NEGATIVE SVCHR, DCA CH JMS NU /GET ACCUMULATED NUMBER CMA /KRONK IT AND SAVE COUNT DCA N1 /FOR ALL CONVERSIONS TAD CH AND (7757 TAD (7770 /THIS TESTS IF CH IS SNA CLA /AN ,X, OR ,H, CM, JMS PR /IT WAS , PROCESS IT JMP RETN /NOT X OR H, KILL NUMBER /AND TRY AGAIN / /IOH.NW - PAGE 3-2 SL, JMS PR /PROCESS PREVIOUS ITEM, JMS EJ /IF ANY JMP RETN QT, JMS PR /PROCESS PREVIOUS ITEM, QT1, JMS GFRM /IF ANY TAD (-47 SNA /ANOTHER QUOTE? JMP RETN TAD (47 JMS PRINT /PRINT CHAR JMP QT1 DG, JMS DGT /ACCUMULATE DGT IN SACH JMP RTUR /TRY ANOTHER CHARACTER LP, ISZ PUSH /LEFT PAREN CLA CMA /COUNT NESTING TAD NPAR /DEPTH, NEGATIVE DCA NPAR TAD SW /PICK UP THE FORMAT PTR DCA I PUSH /CRAM IT INTO THE LIST ISZ PUSH /KICK AGAIN JMS NU /THERE MAY BE AN CIA /ACCUMULATED NUMBER, DCA I PUSH /SAVE NUMBER CLA CLL CML RTL /HERE WE SEE IF THIS IS TAD NPAR /AN POSSIBLE RESTART /POINT SPA CLA /IF FIRST SAVE SW IN S1 JMP RETN /NOPE- FORGET IT TAD SW /YES--FIRST CRAM FORMAT--- DCA S1 /---INTO SAVE1 AND TAD I PUSH /THAT STUFF IN THE LIST--- DCA S2 /---GOES INTO SAVE 2 JMP RETN /READY FOR ANYTHING, /HERE WE GO / /IOH.NW - PAGE 3-3 RPAR, JMS PR /PROCESS PREVIOUS ITEM, ISZ I PUSH /IF ANY JMP TR CLA CLL CMA RAL /-2 TAD PUSH /DELETE THIS ITEM FROM DCA PUSH /THE LIST, PUSH = PUSH-2 ISZ NPAR /NPAR= NPAR+1 ]-1[ SINCE /MINUS COUNT JMP RETN JMS WH /THIS PAREN WAS THE TAD S1 /BALANCING PAREN,GET THE DCA SW /FORMAT POINTER OF THE /RESTART POINT /AND CRAM IT TAD S2 /GET SWITCH AND THE CIA /COUNT FENTER, DCA SACH CLA CMA TAD SW /TEST TO SEE IF SW SNA CLA /IS ORIGINAL POINTER JMP L2 /YES - FAKE A RESTART ISZ PUSH /NO - PUSH ORIGINAL CLA IAC /POINTER SINCE WE ARE DCA I PUSH /RETURNING TO DEPTH 2 ISZ PUSH CLA CMA /SET COUNT=1, SWITCH=1 DCA I PUSH CMA L2, DCA NPAR /PARNRN = -1 JMP LP TR, CLA CMA /GET OUT THE FORMAT TAD PUSH /POINTER-- * DCA N3 TAD I N3 DCA SW /HAA--IT IS NOW RESTORED JMP RETN /AWAY WE GO PER, JMS NU /GOT A PERIOD, MUST BE E DCA N3 /OR F TYPE JMP RETN PAGE /EXPERIMENTAL /IOH.NW - PAGE 4-1 /THIS IS E FORMAT CONVERSION EX, JMS GLST EE, JMS NR /CHECK IF INPUT -IF NOT, /GET NUMBER INTO [.1,1] TAD C /STORE C AWAY DCA GLST /IN A SAFE PLACE DCA C CLA CMA /SET "E FORMAT FAKEOUT" DCA EFLG /FLAG TO -1 TAD (-5 /FAKE OUT "F" FORMAT JMP FFAKE /TO PRINT DIGITS /NOW PRINT "E AND 'C' DIGITS UNDER I3 FORMAT PRNTE, TAD (5 /PUT OUT THE E JMS PRINT TAD GLST SPA CLA CLA CLL CMA RAL TAD (55 JMS PRINT /PRINT A MINUS OR PLUS TAD GLST SPA CIA CALL 1,DIV ARG TW TAD (60 JMS PRINT /PRINT CPAGE 4 CALL 0,IREM /IREM NEEDS AN ARGUMENT EFLG, 0 /ARGUMENT IS CRX, 0 /IGNORED TAD (60 JMS PRINT /PRINT SECOND DIGIT JMP EX /DONE, DO NEXT / /IOH.NW - PAGE 4-2 /THIS IS F FORMAT CONVERSION FX, CLA JMS GLST FF, JMS NR /CHECK IF INPUT -IF NOT, /GET NUMBER INTO /RANGE [.1,1] DCA EFLG TAD C /C CONTAINS NUMBER OF /MULTS TO RANGE NUMBER SMA CLA CMA /0 MULTS NEEDED OR /ALREADY THERE FFAKE, TAD N3 /NUM3 IS THE FIELD WIDTH CIA /MINUS SPACE FOR DADP+DP TAD N2 /PUT OUT JMS SA /REQUIRED BLANKS + SIGN TAD C SMA JMP PRZRO /NO LEADING DIGIT - / PRINT A ZERO FOR LOOKS CIA JMS DT PRDCPT, TAD (56 JMS PRINT TAD C /GET MULTIPLY COUNT SPA SNA JMP PAS2 CMA /THEY WERE MULTIPLIES, DCA CRX /0 TO N OF THEM TAD N2 /DIGITS AFTER DEC POINT CMA DCA NR JMP PASA /TEST FOR 0 MULTIPLIES RETR, TAD (60 /PUT OUT A ZERO JMS PRINT /ALL MULTIPLIES /REPRESENTED PASA, ISZ CRX /NO, TRY RUN OFF FIELD SKP JMP PASS /YES ISZ NR /ALL WIDTH ACCOUNTED FOR JMP RETR /NO, TRY NEXT POSITION PASS, TAD C /YES, GET MULT COUNT CIA /-MULT COUNT SKP PAS2, CLA TAD N2 /N2-MULT COUNT SMA SZA /IS MULT COUNT .GE. N2? JMS DT /PRINT REMAINING DIGITS ISZ EFLG /WERE WE FAKED /OUT BY "E" FORMAT? JMP FX /NO JMP PRNTE /YES - GO PRINT EXPONENT PRZRO, CLA TAD (60 JMS PRINT JMP PRDCPT /GO BACK TO PRINT /THE DECIMAL POINT / /IOH.NW - PAGE 4-3 /PRINT BLANKS AND MINUS SIGN, IF ANY SA, 0 TAD SN SMA /THIS IS-(NUM OF BLANKS) JMP AS3 /POSITIVE, NUMBER /TOO BIG FOR FIELD DCA CRX SKP CLA RETC, JMS PRINT /HERE WE PUT TAD (40 /THAT MANY BLANKS ISZ CRX JMP RETC /YES CLA TAD SN SNA CLA /IS SIGN MINUS? JMP I SA /EVIDENTLY NOT TAD (55 JMS PRINT /PUT OUT A MINUS SIGN JMP I SA /ACCUMULATE DIGIT IN SACH DGT, 0 DCA SACM TAD SACH CLL RTL TAD SACH RAL TAD SACM DCA SACH JMP I DGT PAGE /EXPERIMENTAL /IOH.NW - PAGE 5-1 /INPUT FOR E OR F OR O FORMAT FN, TAD PRRT# /INITIALIZATION FOR DCA PBLANK# /E OR F FORMAT TAD PFX DCA VZE TAD ZRRS# DCA ZBLANK# TAD N3 /GET WIDTH CMA /1'S COMPLEMENT FN1, DCA CR /TO COUNTER DCA D1 /0 TO D1 CALL 0,CLEAR CMA DCA D2 /-1 TO DECIMAL POINT SWI CMA /-0 TO SGN FLAG RRTSGN, DCA SN RRT, CLA ISZ CR /SEE IF WIDTH EXCEEDED SKP JMP FP JMS GCHR /GET AN INPUT CHARACTER /AND TEST IT CPAGE 20 JMS CHTYPE /CLASSIFY INPUT CHAR FDIGIT /DIGIT -56; PUNT PBLANK, -40; RRT PRRT, -53; RRT -55; RRTSGN -5; EPRO PERR3, 0;ERR3 / /IOH.NW - PAGE 5-2 FDIGIT, DCA IS CMA DCA BLSW /SET FOR TRAILING BLANKS CALL 1,FMP ARG TN CALL 1,STO /SAVE FLOATING POINT ACC ARG SV TAD IS CALL 0,FLOT /FLOAT NEW DIGIT CALL 1,FAD ARG SV INC D1 /COUNT OF DIGITS JMP RRT PUNT, ISZ D2 /TST DP SWITCH JMPI PERR3# DCA D1 JMP RRT FBLANK, DCA BA /CLEAR RETURN SWITCH ISZ BLSW JMP RRT /IGNORE LEADING BLANKS ISZ BA /FAKE A RETURN TAD PGX DCA VZE JMP FP EPRO, CLA CMA /AN E FP, DCA IS /-1 TO IS IF E, /0 TO IS IF END OF FIELD ISZ D2 /TEST DP SWITCH JMP FA /ONE HAS OCCURRED TAD N2 /NOT OCCURRED, GET DADP SKP FA, TAD D1 /COUNT OF DIGITS AFTER /EXPLICIT DP CMA /-COUNT JMS DH /DIVIDE FPAC /BY TEN COUNT TIMES ISZ SN /TEST SIGN CLA CLL CML RAR TAD ACH DCA ACH ISZ IS /DID WE GET AN "E"? JMP VZA /NO - STORE RESULT AND /GET OUT JMP VQ /YES - FAKE INTEGER /ROUTINE TO ACCEPT EXP. / /IOH.NW - PAGE 5-3 D1, 0 /DIGIT COUNT D2, 0 /DECIMAL POINT SWITCH IS, 0 /SWITCH FOR EXPLICIT E CR, 0 /WIDTH COUNTER PFX, JMP FX PGX, JMP GX PRO2, CMA /GOT EXPONENT - MAKE IT /NEGATIVE ISZ SN /WHAT WAS ITS ORIGINAL /SIGN? JMP VZB /NEGATIVE - DIVIDE BY /10^EXP DCA D1 /SAVE COUNT JMP VZD VZC, CALL 1,FMP ARG TN VZD, ISZ D1 /INDEX COUNT JMP VZC JMP VZA VZB, JMS DH VZA, CALL 1,ISTO /STORE IN PLACE ARG ARGUMT VZE, JMP FX PAGE /EXPERIMENTAL /IOH.NW - PAGE 6-1 /THIS IS THE X FIELD PROCESSOR XX, JMS MR /TEST FOR MORE TAD IO /TEST FOR INPUT-OUTPUT SNA CLA JMP XX1 /INPUT, PSEUDO-JUMP TAD (40 /OUTPUT A BLANK JMS PRINT JMP XX /CYCLE XX1, JMS GCHR /IGNORE SPACES ON INPUT CLA JMP XX /THIS IS THE H FIELD PROCESSOR HH, JMS MR JMS GFRM /SAME AS XXX, BUT PRINT JMS PRINT /- NEXT FORMAT CHARACTER JMP HH /OUTPUT ONLY /PRINT OUT AN CHARACTER PRINT, 0 TAD (-40 SPA TAD (100 /CONVERT 6-BIT TO 8-BIT TAD (240 TAD DV /ADD ON DEVICE NUMBER /IN BITS 0-3 CALL 0,GENIO JMP I PRINT /END THE RECORD AND TEST FOR MORE PARAMETERS WH, 0 JMS EJ /END THE RECORD TAD ARGUMT# SNA CLA /TEST PARAMETER FOR 0 JMS GLST /RETURN TO MAIN PROGRAM /ON 0 PAR JMP I WH /MORE ARGUMENTS RETURN / /IOH.NW - PAGE 6-2 /ROUTINE TO END RECORD EJ, 0 TAD IO SZA CLA /INPUT OR OUTPUT? JMP E1 /OUTPUT E2, CLA TAD BA SZA CLA JMP BG /CARRIAGE RETURN SEEN /- GOODBYE JMS GCHR /GET A CHARACTER JMP E2 /KEEP LOOKING FOR CR BG, DCA BA JMP I EJ E1, TAD (7715 /7715 TRANSLATES TO 215 JMS PRINT TAD (7712 JMS PRINT /PRINT CR-LF JMP I EJ BA, 0 /END OF LINE SWITCH /GET AN INPUT STRING CHARACTER GCHR, 0 JD, CLA TAD BA /GET EOR SWITCH SZA CLA JMP BL /IS EOR, RETURN BLANK CLA CLL CML RTR /****** IF # OF DEVICES /IS CHANGED, THIS SHOULD TAD DV /BE CHANGED TOO ***** /CALL GENIO WITH CALL 0,GENIO /OFFSET DEVICE NUMBER AND (177 /STRIP PARITY TAD (7763 SNA /CARRIAGE RETURN? JMP BH TAD (4 SNA /TAB ? TAD (27 /YES, REPLACE BY A BLANK TAD (7651 CLL TAD (100 /IS CHAR IN RANGE SNL /237=0 = LEADING BLANKS END