Directory of image this file is from
This file as a plain text file
/ /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<CHAR<340 ? JMP JD /NO - IGNORE JMP BL /CONVERT TO SIXBIT /AND RETURN BH, ISZ BA /ENTRY TO LOOK FOR AN /END OF LINE BL, TAD (40 AND (77 /KEEP THIS - BL IS /REFERENCED BY GCHR JMP I GCHR / /IOH.NW - PAGE 6-3 /THIS IS THE G FORMAT CONVERSION GX, CLA JMS GLST GG, JMSKP BB SKP JMP ERR1 /G-FORMAT ONLY INPUT TAD GG1 /INITIALIZATION GY, DCA PBLANK# /FOR G FORMAT TAD JJ1 DCA ZBLANK# DCA BLSW JMP FN1 GG1, FBLANK /THIS IS THE J FORMAT CONVERSION JX, CLA JMS GLST JJ, JMSKP BB SKP JMP ERR1 /J-FORMAT ONLY INPUT TAD JJ1 /INITIALIZATION JY, DCA ZBLANK# /FOR J FORMAT DCA BLSW JMP IN1 JJ1, IBLANK
PAGE /EXPERIMENTAL /IOH.NW - PAGE 7-1 /GET F.P. NUMBER INTO THE RANGE.1 .LE. N .L. 1.0 NR, 0 JMSKP BB /CHECK DIRECTION OF I/O JMP FN /INPUT CALL 1,IFAD /OUTPUT - LOAD NUMBER ARG ARGUMT /INTO FLOATING AC DCA SN /CLEAR THESE LOCS DCA C TAD ACH SNA JMP NREX /NUMBER IS ZERO SMA /IS IT A MINUS F P NUMBER JMP RETM TAD (4000 /YES-- MAKE IT POSITIVE ISZ SN /SET SIGN DCA ACH RETM, CLA /MULTIPLY BY 10 UNTIL /NR .GT. (1.0) TAD ACH TAD (5764 /-2014=1. SMA CLA JMP TB /GOT IT IT IS .GE.1 CALL 1,FMP ARG TN ISZ C /AND COUNT JMP RETM /GO TRY TO DO IT AGAIN TB, JMS SE /NOTE SE ' XR-1 CALL 1,STO ARG SV TAD (2004 DCA ACH /200400000000=.5 IN FL.AC TAD CH /TEST FORMAT TAD (7772 SNA CLA /IS IT E FORMAT? TAD C /NO - COUNT # OF CIA /MULTS NEEDED TAD N2 /< DADP SMA CMA /NUMBER OF THIMES TO /DIVIDE .5 BY 10 TO RND JMS DH /DO THE DIVIDES CALL 1,FAD ARG SV JMS SE /REDUCE TO NORMAL RANGE /AGAIN / /IOH.NW - PAGE 7-2 GD, TAD ACH RAL SPA CLA JMP ZP /NUMBER IS ? 1/2 TAD ACH CLL RAR /GET THE EXP TO 200 DCA ACH TAD ACM RAR DCA ACM TAD ACL RAR DCA ACL TAD ACH AND (7774 TAD ACH TAD (10 DCA ACH JMP GD ZP, TAD ACH AND (7 DCA ACH NREX, JMP I NR SN, 0 C, 0 /COUNTER FOR DEC. EXP. / /IOH.NW - PAGE 7-3 /DIVIDE BY 10. UNTIL N < 1.0 SE, 0 XR, TAD ACH /TEST NUMBER FOR .GE. 1 TAD (5764 /-2014=1.0 SPA CLA JMP I SE /NUMBER IS IN RANGE CLA CLL CMA RAL /-2 JMS DH CLA CMA /REDUCE COUNT TAD C DCA C JMP XR /DIVIDE FPAC BY TEN CX TIMES DH, 0 DCA CX JMP DTA DTB, CALL 1,FDV ARG TN DTA, ISZ CX JMP DTB JMP I DH
PAGE /EXPERIMENTAL /IOH.NW - PAGE 8-1 /GET NEXT ARGUMENT ROUTINE GLST, 0 CALL 0,CLEAR /CLEAR FLOATING AC ISZ IOHCNT /ARE WE IN AN /ARRAY I/O LOOP? JMP ARMORE /YES - GET NEXT ELEMENT INC IOH# /RETURN TO USERS RETRN IOH /PROGRAM FOR MORE DATA ARMORE, TAD ARGUMT# TAD IOHINC /BUMP ARGUMENT POINTER /BY ELEMENT LENGTH JMP IOHBAK /RESUME I/O CONVERSIONS /WITH UPDATED ARGUMT CPAGE 33 IOH, BLOCK 2 SZA CLA /SCALAR OR ARRAY CALL? JMP IOHAR /AN ARRAY CALL CLA CMA IOGTAR, DCA IOHCNT /SET UP ARGUMENT COUNT /FOR THIS CALL TAD IOH DCA IOH1 IOH1, NOP /SET DATA FIELD TO /ARGUMENT LIST TADI IOH# DCA ARGUMT INC IOH# TADI IOH# IOHBAK, DCA ARGUMT# JMP I GLST /RETURN TO I/O CONVERSION IOHAR, INC IOH# CLA CLL CML RAR /AC=4000 AND I IOH /GET TYPE OF ARRAY CLL RTL /FORM A 1 OR A 3, CML RAL /DEPENDING ON ARRAY TYPE DCA IOHINC CLA CLL CMA RAR /AC=3777 ANDI 7 /GET THE ELEMENT COUNT CIA INC IOH# JMP IOGTAR /SAVE IT AND GET ARRAY /POINTER IOHINC, 0 IOHCNT, 0 / /IOH.NW - PAGE 8-2 /SUBROUTINE TO CLASSIFY FORMAT CHARACTERS CHTYPE, 0 DCA CHCH TAD CHCH TAD (7706 CLL TAD (12 SZL /IS CHARACTER NUMERIC? JMP JMPOUT /YES - TAKE FIRST EXIT INC CHTYPE CHLOOP, CLA TAD I CHTYPE INC CHTYPE SNA /CHAR LIST EXHAUSTED? JMP JMPOTX /YES - TAKE LAST EXIT /WITH CHAR IN AC TAD CHCH SNA CLA /MATCH? JMP JMPOUT /YES-TAKE EXIT WITH AC=0 INC CHTYPE JMP CHLOOP /NO MATCH - GO ON /TO NEXT CHAR JMPOUT, DCA CHCH JMPOTX, TAD I CHTYPE DCA CHTYPE TAD CHCH JMP I CHTYPE CHCH, 0 /LEFT SHIFT THE FPAC 1 LS, 0 TAD ACL CLL RAL DCA ACL TAD ACM RAL DCA ACM TAD ACH RAL DCA ACH JMP I LS /DONE / /IOH.NW - PAGE 8-3 /OUTPUT DIGITS FROM FLOATING AC DT, 0 CIA DCA CHCH /STORE COUNT RETT, JMS LS /LEFT SHIFT 1 TAD ACL /SAVE THE FPAC DCA SACL TAD ACM DCA SACM TAD ACH AND (17 DCA SACH TAD SACH DCA ACH /TRIM AC TO 28 BITS JMS LS /LEFT SHIFT 2 JMS LS TAD ACL /ADD THE DSAVE TO THE ACC TAD SACL DCA ACL RAL /* TAD ACM TAD SACM DCA ACM RAL /* TAD ACH TAD SACH DCA ACH TAD ACH CLL RAR /ROTATE 3 RIGHT RTR AND (17 TAD (60 /MAKE DIGIT JMS PRINT /DUMP IT AND SEE /IF ANY MORE ISZ CHCH /LOOP ON COUNT JMP RETT /* JMP I DT
PAGE /EXPERIMENTAL /IOH.NW - PAGE 9-1 /PROCESS THE FORMAT ITEM, IF ANY PR, 0 TAD SACH /GET LAST ACCUMULATED DCA N2 /NUMBER AND SAVE IT PR2, TAD CH SNA JMP I PR /NOTHING TO DO CPAGE 22 JMS CHTYPE /CLASSIFY CH ERR1 /DIGIT IS ILLEGAL -30;XX -12;JJ /NEW FORMAT -11;II -10;HH -7;GG /NEW FORMAT -6;FF -5;EE -1;AA 0;ERR1 /TEST FOR MORE FIELDS MR, 0 /MORE? ISZ N1 /SEE IF IT GOES TO ZERO JMP I MR DCA CH /NO MORE FIELDS, FIRST /WIPE CHAR, THAN GO JMP I PR /BACK TO FORMAT SCANNER /ROUTINE TO FETCH THE ACCUM NUMB NU, 0 TAD SACH SNA /IF IT IS 0, SET IT TO 1 CLA IAC /IT IS AND WE DO JMP I NU /GO HOME
/ /IOH.NW - PAGE 9-2 /TEST MORE AND ZERO CURRENT LIST ITEM /ALSO TEST DIRECTION OF I/O BB, 0 JMS MR /MORE? TAD ARGUMT# SNA CLA /IF ARG=0, JMS WH /END RECORD AND RETURN /TO USERS PROGRAM TAD IO /TEST IN OUT SWITCH SZA CLA /OUTPUT / INC BB /YES, INC RETURN ADRESS JMP I BB /THIS IS THE A FORMAT PROCESSOR AX, JMS GLST AA, TAD N2 CIA DCA CX JMSKP BB JMP AR AS, JMS GADR /GET CHARACTER ADDRESS TADI 7 SZL JMP ASNORT RTR RTR RTR ASNORT, AND (77 /MASK 6 BITS JMS PRINT ISZ CX JMP AS /LOOP FOR CHARACTER COUNT JMP AX /GET NXT ARGUMENT(IF ANY) AR, JMS GCHR DCA BB /GET AND SAVE INPUT CHAR JMS GADR /GET CHARACTER POINTER TAD BB SZL /WHICH HALF? JMP ARNORT /RIGHT HALF IAC RTL RTL RTL SKP ARNORT, TADI 7 TAD (7740 /CANCEL BLANK CHAR DCAI 7 ISZ CX JMP AR JMP AX / /IOH.NW - PAGE 9-3 /SUBR TO COMPUTE CHARACTER ADDR FOR "A" FMT GADR, 0 TAD ARGUMT DCA AS1 TAD N2 TAD CX CLL RAR TAD ARGUMT# /AC=WORD POINTER, /LINK=LEFT/RIGHT FLAG DCA 7 AS1, NOP /SET UP DATA FIELD /OF ARGUMENT JMPI GADR CX, 0 /PRINT ASTERISKS FOR WHOLE FIELD SIZE AS3, CLA TAD N3 /GET FIELD SIZE, E OR F CMA DCA CX /-COUNT JMP QQ QQA, TAD (52 /PRINT CX ASTERISKS JMS PRINT QQ, ISZ CX /INDEX COUNT JMP QQA JMS GLST /TEST FOR MORE JMP PR2 /RETURN TO FORMAT /PROCESSOR, SAME TYPE
PAGE /EXPERIMENTAL /IOH.NW - PAGE 10-1 /INTEGER INPUT IN, TAD ZRRS# /INITIALIZATION DCA ZBLANK# /FOR I FORMAT TAD IX DCA IN2 TAD N2 /GET WIDTH OF FIELD CMA /1,S COMP TO COUNTER, CR IN1, DCA CR CMA VQ, DCA WHI /-1 TO NUMBER ACCUMULATED CMA /-1 TO SIGN RRSIGN, DCA SN DCA SACH RRS, ISZ CR /HAS WHOLE NUMBER BEEN /ACCUMULATED SKP JMP PRO JMS GCHR CPAGE 14 JMS CHTYPE /CLASSIFY CHARACTER DIGIT /ITS A DIGIT ZBLANK, -40; RRS ZRRS, -53; RRS -55; RRSIGN ZERR2, 0; ERR2 DIGIT, JMS DGT /ACCUMULATE DGT INTO SACH CMA DCA BLSW /SET FOR TRAILING BLANKS JMP RRS /GET NEXT DIGIT PRO, TAD SACH /WE HAVE AN INTEGER ... ISZ WHI /WHAT KIND? JMP PRO2 /I-EXPONENT FOR E-FORMAT ISZ SN / 'I' FORMAT CIA DCA I ARGUMT IN2, CLA / /IOH.NW - PAGE 10-2 /THIS IS THE I FORMAT CONVERSION IX, CLA JMS GLST /INTEGER CONVERSION II, JMSKP BB /TEST MORE AND NON ZERO /CURRENT LIST ITEM JMP IN /INPUT TAD AB DCA SACL /OUTPUT TAD (-4 DCA WHI /-4 DCA SN /0 TAD I ARGUMT SMA /SET SN = 0 FOR PLUS, /=1 FOR MINUS JMP XZ /PLACE MAGNITUDE IN 20 CIA ISZ SN XZ, CALL 1,DIV ARG TW DCA SACH CPAGE 4 CALL 0,IREM /IREM NEEDS AN ARGUMENT AB, I1 /ARGUMENT IS WHI, 0 /IGNORED DCA I SACL /SAVE REMAINDER CMA TAD SACL /SACL=SACL-1 DCA SACL ISZ WHI /INDEX COUNT TAD SACH /AND CHECK NUM FOR 0 SZA JMP XZ /CYCLE TAD N2 DCA N3 /IN CASE OF OVERFLOW TAD N2 CMA TAD WHI TAD (4 /COMPUTE NUMBER OF /LEADING BLANKS JMS SA /PRINT LEADING BLANKS /AND SIGN ID, INC SACL /POINT TO DIGIT TO /PRINT NEXT TAD I SACL /GET IT SPA /TERMINATOR? JMP IX /YUP TAD (60 JMS PRINT /NOPE - PRINT THE DIGIT JMP ID /GET NEXT / /IOH.NW - PAGE 10-3 IBLANK, DCA BA /CLEAR RETURN SWITCH ISZ BLSW JMP RRS ISZ BA /FAKE A RETURN TAD ZJX DCA IN2 JMP PRO ZJX, JMP JX BLSW, 0 /-1=TRAILING BLANKS />=0 = LEADING BLANKS END