File IOH.SB (8k SABR macro assembler source file)

Directory of image this file is from
This file as a plain text file

/ 10.A	IOH SUBROUTINE			OS8 FORTRAN II LIBRARY
/
/	25-SEP-78			W. HOUBEN
/
/	COPYRIGHT 1978, DIGICOS SOFTWARE DEVELOPMENT GROUP
/
/	VERSION 10A
/	APRIL 28,1977
/	INPUT OUTPUT CONVERSION SUBROUTINE
/	FOR 8K ALICS-FORTRAN SYSTEM
/	VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
/
	ABSYM SACH 23		/SAVE FPAC FOR MANIPULATION OF AC
	ABSYM SACM 24
	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 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
TW,	12
READ,	BLOCK 1
	10			/ENTRY POINT FOR READ
RETRY,	TAD	READ		/SNEAK IN
	DCA	WRITE
	TAD	READ#
	DCA	WRITE#		/SAVE SECOND RETURN WORD
	JMP	ET
	CPAGE 4
IO,	0
SW,	0			/LEFT OR RIGHT HALF OF FORMAT
WRITE,	BLOCK 1
	10			/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
	TADI	7		/PICK UP DEVICE NUMBER
	AND	(17		/TAKE IT MOD 16(10)
	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 FORMAT
	DCA	SW	/FROM SECOND CHARACTER (FIRST IS LPAREN)
	DCA	BA	/ZAP END-OF-LINE SWITCH
	TAD	PENTER	/FAKE RE-ENTRY TO SET UP FIRST LPAREN
	DCA	GLST	/ON PUSHDOWN STACK
	RETRN	WRITE
PENTER,	FENTER

FPNT,	0
GFRM,	0
	TAD	SW
	INC	SW
	CLL RAR
	TAD	FPNT		/FORM ADDRESS IN AC AND LEFT/RIGHT
	DCA	7		/SWITCH 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 RETN, DCA SACH /SET SACH TO 0 RTUR, JMS GFRM /GET NEXT CHAR IN FORMAT CPAGE 24 JMS CHTYPE /CLASSIFY FORMAT CHARACTER DG /DIGIT EXIT -57; SL -56; PER -54; CM -51; RPAR -50; LP -47; QT -40; RTUR 0; SVCHR SVCHR, DCA CH JMS NU /GET THE ACCUMULATED NUMBER CMA /KRONK IT DCA N1 /AND SAVE COUNT FOR ALL CONVERSIONS TAD CH AND (7757 TAD (7770 /THIS TESTS IF CH IS AN ,X, OR ,H, SNA CLA CM, JMS PR /IT WAS , PROCESS IT JMP RETN /NOT X OR H, KILL NUMBER AND TRY AGAIN N1, 0 SL, JMS PR /GO PROCESS THE PREVIOUS ITEM (IF ANY) JMS EJ JMP RETN QT, JMS PR /PROCESS PREVIOUS ITEM, IF ANY QT1, JMS GFRM TAD (-47 SNA /ANOTHER QUOTE? JMP RETN TAD (47 JMS PRINT /PRINT CHAR JMP QT1 DG, JMS DGT /ACCUMULATE DIGIT INTO SACH JMP RTUR /TRY ANOTHER CHARACTER LP, ISZ PUSH /LEFT PAREN CLA CMA /COUNT NESTING DEPTH, NEGATIVE TAD NPAR DCA NPAR TAD SW /PICK UP THE FORMAT POINTER DCA I PUSH /CRAM IT INTO THE LIST ISZ PUSH /KICK AGAIN JMS NU /THERE MAY BE AN ACCUMULATED NUMBER CIA /SAVE NUMBER DCA I PUSH /* CLA CLL CML RTL /HERE WE SEE IF THIS IS A POSSIBLE TAD NPAR /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 TAD I PUSH /AND THAT STUFF IN THE LIST--- DCA S2 /---GOES INTO SAVE 2 JMP RETN /READY FOR ANYTHING, HERE WE GO PUSH, 0 /PARENTHESIS PUSHDOWN LIST POINTER RPAR, JMS PR /PROCESS PREVIOUS ITEM, IF ANY ISZ I PUSH JMP TR CLA CLL CMA RAL /-2 TAD PUSH /DELETE THIS ITEM FORM THE LIST DCA PUSH /PUSH = PUSH-2 ISZ NPAR /NPAR = NPAR +1 ]-1[ SINCE MINUS COUNT JMP RETN JMS WH /THIS PAREN WAS THE BALANCING PAREN TAD S1 /GET THE FORMAT POINTER OF THE-- DCA SW /RESTART POINT AND CRAM IT TAD S2 /GET SWITCH AND THE COUNT CIA FENTER, DCA SACH CLA CMA TAD SW /TEST TO SEE IF SW IS ORIGINAL POINTER SNA CLA JMP L2 /YES - FAKE A RESTART ISZ PUSH /NO - PUSH ORIGINAL POINTER CLA IAC /SINCE WE ARE RETURNING TO DEPTH 2 DCA I PUSH 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 POINTER-- TAD PUSH /* DCA N3 TAD I N3 DCA SW /HAA-- IT IS NOW RESTORED JMP RETN /AWAY WE GO N3, 0 /W FOR E AND F CONVER PER, JMS NU /GOT A PERIOD, MUST BE OR F TYPE DCA N3 JMP RETN S1, 0 S2, 0 /SAVE THE COUNT AND SWITCH NPAR, 0
PAGE /EXPERIMENTAL EX, JMS GLST /THIS IS E FORMAT CONVERSION EE, JMS NR /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1] TAD C DCA GLST /STORE C AWAY IN A SAFE PLACE DCA C CLA CMA DCA EFLG /SET "E FORMAT FAKEOUT" FLAG TAD (-5 JMP FFAKE /FAKE OUT "F" FORMAT TO PRINT DIGITS PRNTE, TAD (5 /PUT OUT THE E JMS PRINT / NOW PRINT 'C' DIGITS UNDER I3 FORMAT TAD GLST SPA SNA 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 TO IGNORE EFLG, 0 CRX, 0 TAD (60 JMS PRINT /PRINT SECOND DIGIT JMP EX /DONE, DO NEXT FX, CLA JMS GLST /THIS IS F FORMAT CONVERSION FF, JMS NR /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.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 JMS SA /PUT OUT 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, 0 TO N OF THEM DCA CRX TAD N2 /DIGITS AFTER DEC POINT, DADP 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 /NO - 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 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 OUT THAT MANY BLANKS TAD (40 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
PAGE /EXPERIMENTAL FN, TAD N3 /GET WIDTH, INPUT FOR E OR F FORMAT CMA /1'S COMPLEMENT DCA CR /TO COUNTER DCA D1 /0 TO D1 CALL 0,]CLR CMA DCA D2 /-1 TO DECIMAL POINT SWITCH CMA /-0 TO SGN FLAG RRTSGN, DCA SN RRT, CLA ISZ CR /INDEX TO SEE IF WIDTH EXCEEDED SKP JMP FP /GET AN INPUT CHARACTER AND TEST IT JMS GCHR CPAGE 20 JMS CHTYPE /CLASSIFY INPUT CHAR FDIGIT /DIGIT -56; PUNT -40; RRT -53; RRT -55; RRTSGN -5; EPRO 0 PERR3, ERR3 FDIGIT, DCA IS CALL 1,FMP ARG TN CALL 1,STO /SAVE FLOATING POINT ACCUMULATOR 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 /***** TWO DECIMAL POINTS ***** DCA D1 JMP RRT 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 /ONE HAS NOT OCCURRED, GET NDP SKP FA, TAD D1 /COUNT OF DIGITS AFTER EXPLICIT DP CMA /-COUNT JMS DH /DIVIDE FPAC BY TEN COUNT TIMES TAD ACH /IF ACH=0,DON'T CHK. SIGN SNA JMP ZR /ZERO-DON'T CHECK ISZ SN /TEST SIGN TAD (4000 /SET SIGN BIT DCA ACH ZR, ISZ IS /DID WE GET AN "E"? JMP VZA /NO - STORE RESULT AND GET OUT JMP VQ /YES - FAKE INTEGER ROUTINE TO ACCEPT EXPONENT D1, 0 D2, 0 IS, 0 CR, 0 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 JMP FX
PAGE /EXPERIMENTAL 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 HH, JMS MR /THE H FIELD PROCESSOR JMS GFRM /SAME AS XXX, BUT PRINT NEXT JMS PRINT /----- FORMAT CHARACTER JMP HH /OUTPUT ONLY 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,]PUT JMP I PRINT 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 AGRUMENTS RETURN EJ, 0 /ROUTINE TO END RECORD 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 /THIS IS THE END OF LINE SWITCH 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 GCHR, 0 /GET AN INPUT STRING CHARACTER JD, CLA TAD BA /GET EOR SWITCH SZA CLA JMP BL /IS EOR, RETURN BLANK TAD DV CALL 0,]GET AND (177 /STRIP PARITY TAD (7763 SNA /CARRIAGE RETURN? JMP BH TAD (7655 CLL TAD (100 /IS CHAR IN RANGE 237<CHAR<340? SNL JMP JD /NO - IGNORE JMP BL /CONVERT TO SIXBIT AND RETURN
PAGE /EXPERIMENTAL / 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 INTO FLOATING AC ARG ARGUMT 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 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=.50000 IN AC TAD CH /TEST FORMAT TAD (7772 SNA CLA /IS IT E FORMAT? TAD C /NO - COUNT # OF MULTS NEEDED CIA 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 GD, TAD ACH RAL SPA CLA JMP ZP /NUMBER IS ? 1/2 TAD ACH CLL RAR /WE ARE GETTING 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. SE, 0 /DIVIDE BY 10 UNTIL N < 1.0 XR, TAD ACH /TEST NUMBER FOR .GE. 1 TAD (5764 SPA CLA JMP I SE /NUMBER IS IN RANGE, RETURN CLA CLL CMA RAL JMS DH CLA CMA /REDUCE COUNT TAD C DCA C JMP XR
PAGE /EXPERIMENTAL GLST, 0 /GET NEXT ARGUMENT ROUTINE CALL 0,]CLR /CLEAR FLOATING AC ISZ IOHCNT /ARE WE IN AN ARRAY I/O LOOP? JMP ARMORE /YES - GET NEXT ELEMENT INC IOH# RETRN IOH /RETURN TO USERS 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 1 10 SZA CLA /IS THIS A SCALAR OR AN 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 AND I IOH /GET TYPE OF ARRAY CLL RTL CML RAL /FORM A 1 OR A 3, DEPENDING ON ARRAY TYPE DCA IOHINC CLA CLL CMA RAR ANDI 7 /GET THE ELEMENT COUNT CIA INC IOH# JMP IOGTAR /SAVE IT AND GET ARRAY POINTER IOHINC, 0 IOHCNT, 0 CHTYPE, 0 /SUBROUTINE TO CLASSIFY CHARACTERS DCA CHCH TAD CHCH TAD (7706 CLL TAD (12 SZL /IS THE CHARACTER NUMERIC? JMP JMPOUT /YES - TAKE FIRST EXIT INC CHTYPE CHLOOP, CLA TAD I CHTYPE INC CHTYPE SNA /CHARACTER 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 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 LS, 0 /LEFT SHIFT THE FPAC 1 TAD ACL CLL RAL DCA ACL TAD ACM RAL DCA ACM TAD ACH RAL DCA ACH JMP I LS /DONE
PAGE /EXPERIMENTAL PR, 0 TAD SACH /GET THE LAST NUMBER ACCUMULATED DCA N2 /SAVE IT PR2, TAD CH SNA JMP I PR /NOTHING TO DO CPAGE 22 JMS CHTYPE /CLASSIFY CH ERR1 /DIGIT IS ILLEGAL -30;XX -11;II -10;HH -6;FF -5;EE -1;AA 0;ERR1 MR, 0 /MORE? ISZ N1 /SEE IF IT GOES TO ZERO JMP I MR DCA CH /NO MORE FIELDS, FIRST WIPE CHAR JMP I PR /GO BACK TO FORMAT SCANNER NU, 0 /ROUTINE TO FETCH THE ACCUM NUMB TAD SACH SNA /IF IT IS ZERO, SET IT TO 1 CLA IAC /IT IS AND WE DO JMP I NU /GO HOME 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 /INPUT JMP I BB 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 NEXT ARGUMENT(IF ANY) AR, JMS GCHR DCA DH /GET AND SAVE INPUT CHAR JMS GADR /GET CHARACTER POINTER TAD DH SZL /WHICH HALF? JMP ARNORT /RIGHT HALF IAC RTL RTL RTL SKP ARNORT, TADI 7 TAD (7740 /CANCEL BLANK CHAR ARCOMN, DCAI 7 ISZ CX JMP AR JMP AX GADR, 0 /SUBR TO COMPUTE CHARACTER ADDR FOR "A" FMT 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 DH, 0 DCA CX /DIVIDE FPAC BY TEN CX TIMES JMP DTA DTB, CALL 1,FDV ARG TN DTA, ISZ CX JMP DTB JMP I DH AS3, CLA /PRINT ASTERISKS FOR WHOLE FIELD SIZE 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 IN, TAD N2 /INTEGER INPUT, GET WIDTH OF FIELD CMA /1,S COMP TO COUNTER, CR 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 -40; RRS -53; RRS -55; RRSIGN 0; ERR2 DIGIT, JMS DGT /ACCUMULATE DIGIT INTO SACH JMP RRS /GET NEXT DIGIT PRO, TAD SACH /WE HAVE AN INTEGER ... ISZ WHI /WHAT KIND? JMP PRO2 ISZ SN / 'I' FORMAT CIA DCA I ARGUMT 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 TO IGNORE AB, I1 WHI, 0 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 IB, 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 DGT, 0 DCA SACM TAD SACH CLL RTL TAD SACH RAL TAD SACM DCA SACH JMP I DGT END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search