15 ;*******************************************
25 ; SOURCE  PRINT5
35 ;*******************************************
45 ;
55 ; SEARCH NAME TABLE FOR MATCH TO 'WORD'
65 ;
75 SEARCH,	I=
85 	FINDSW=
95 SERCH1,	INCR I
105 	IF (I.GT.NAMEI) RETURN
115 	DATANE=DATANT(I)
125 	IF (DATANM.NE.WORD) GOTO SERCH1
135 	FINDSW='X'
145 	RETURN
155 ;
165 ;GET NEXT LINE AND INSIST ON DIRECTIVE
175 ;
185 GETDIR,	CALL GETLIN
195 	CALL GATOM
205 	IF (FATALI.NE.0) GOTO GETDIR
215 	IF (ATMTYP.EQ.1) RETURN
225 	ERRCOD=20
235 	CALL FATALA
245 	GOTO GETDIR
255 ;
265 ;PUT OUT A SOURCE LINE
275 ;
285 LISTIN,	LPTLIN=
295 	IF (FATALI.NE.0) GOTO LIST1
305 	IF (LPTSW.EQ.SPACE) RETURN
315 LIST1,	ERRLNM=#INLNUM(1,1)*64+#INLNUM(2,2)
325 	ERRLIN=INLINE
335 	IF (LINES.LE.0) CALL LISTOF
345 	XMIT (2,ERRECD(1,INLSIZ+7))
355 	LINES=LINES-1
365 	IF (FATALI.NE.0) CALL ERROUT
375 	RETURN
385 ;
395 ;PUT OUT HEADING AT TOP OF PAGE
405 ;
415 LISTOF,	IF (LPTOPN.NE.SPACE) GOTO LSTOF1
425 	INIT (2,LPT)
435 	LPTOPN='X'
445 LSTOF1,	FORMS (2,0)
455 	INCR PAGES
465 	SHPAGE=PAGES
475 	XMIT (2,SHDR)
485 	FORMS (2,1)
495 	LINES=58
505 	RETURN
515 ;
525 ; PUT OUT DIAGNOSTIC MESSAGES
535 ;
545 ERROUT,	IF (FATALI.EQ.0) RETURN
555 	ERRECD=
565 	K=4
575 	I=
585 	ICOL=
595 ERROR2,	J=FATALE(K,K+2)
605 	ERRLIN(J,J)='^'
615 	IF (J.LE.ICOL) GOTO ERROR3
625 	ICOL=J
635 ERROR3,	K=K+6
645 	INCR I
655 	IF (I.LT.FATALI) GOTO ERROR2
665 	XMIT (2,ERRECD(1,ICOL+7))
675 	LINES=LINES-1
685 	ERRLIN=
695 	ERRFLG='****'
705 	K=1
715 	I=
725 ERROR4,	IF (LINES.LE.0) CALL LISTOF
735 	J=FATALE(K,K+2)
745 	ERRLIN(1,3)=FATALE(K+3,K+5)
755 	ERRLIN(7,36)=ERRMES(J)
765 	ERRLIN(4,4)='-'
775 	XMIT (2,ERRECD(1,43))
785 	LINES=LINES-1
795 	K=K+3
805 	INCR I
815 	IF (I.LT.FATALI) GOTO ERROR4
825 	FORMS (2,1)
835 	LINES=LINES-1
845 	FATALI=
855 	RETURN
865 ;
875 ;GET INTEGER FROM SOURCE
885 ;
895 GETINT,	CALL GATOM
905 	IF (ATMTYP.NE.3) GOTO GTINT1
915 	IF (DPCOL.EQ.0) RETURN
925 GTINT1,	ERRCOD=11
935 	NUMLIT(1,1)=1
945 	ATOMSZ=1
955 	GOTO FATALA
965 ;
975 ;GET NEXT WORD
985 ;IF INTEGER, TREAT IT AS IF IT WERE A WORD
995 ;
1005 WDINT,	CALL GATOM
1015 	IF (ATMTYP.EQ.1) RETURN
1025 	IF (ATMTYP.EQ.3) GOTO WDINT2
1035 WDINT1,	WORD=
1045 	ERRCOD=1
1055 	GOTO FATALA
1065 WDINT2,	IF (DPCOL.NE.0) GOTO WDINT1
1075 	IF (ATOMSZ.LE.6) GOTO WDINT3
1085 	ATOMSZ=6
1095 WDINT3,	WORD(1,ATOMSZ)=NUMLIT(1,ATOMSZ)
1105 	RETURN
1115 ;
1125 ;READ AN INPUT LINE
1135 ;
1145 GETLIN,	IF (LPTLIN.NE.SPACE) CALL LISTIN
1155 	FATALI=
1165 GETL1,	XMIT (1,INPUTL,GETL3)
1175 	INLSIZ=(4096-(#XLINE(3,3)*64+#XLINE(4,4)))*2-2
1185 ;
1195 ;GET RID OF TABS
1205 ;
1215 	BLANKX=
1225 	HOLDIR=
1235 	K=1
1245 	J=1
1255 GETL2,	IF (#INLINE(J,J).NE.61) GOTO GETL2A
1265 	K=(K+7)/8*8+1
1275 	GOTO GETL2B
1285 GETL2A,	HOLDIR(K,K)=INLINE(J,J)
1295 	INCR K
1305 	IF (INLINE(J,J).EQ.SPACE) GOTO GETL2B
1315 	BLANKX='X'
1325 GETL2B,	INCR J
1335 	IF (J.LE.INLSIZ) GOTO GETL2
1345 	INLINE=HOLDIR
1355 	INLSIZ=K
1365 	LPTLIN='X'
1375 	IF (BLANKX.NE.SPACE) GOTO GETL6
1385 	GOTO GETLIN
1395 GETL3,	FINI (1)
1405 	ON ERROR GETL4
1415 	INIT (1,SYS)
1425 	GOTO GETL1
1435 GETL4,	INLINE='END'
1445 	INLSIZ=3
1455 GETL6,	ICOL=
1465 	EOL=
1475 	RETURN
1485 ;
1495 ;GET NEXT ATOM
1505   
1515 GATOM,	ATMTYP=
1525 	LETSW=
1535 	DPCOL=
1545 	CALL SCANF		;FIND FIRST NON-SPACE
1555 	IF (ICHAR.EQ.SPACE) RETURN
1565 	ACOL1=ICOL		;REMEMBER FIRST COLUMN
1575 	IF (ICHAR.EQ.SQUOTE) GOTO GATM20
1585 ;
1595 GATOM1,	IF (ICHAR.LT.'0') GOTO GATOM4
1605 	IF (ICHAR.LE.'9') GOTO GATOM6
1615 	IF (ICHAR.LT.'A') GOTO GATOM8
1625 	IF (ICHAR.GT.'Z') GOTO GATOM8
1635 	LETSW='X'
1645 	GOTO GATOM6
1655 ;
1665 ;CHARACTER IS NEITHER LETTER NOR DIGIT
1675 ;
1685 GATOM4,	IF (ICHAR.NE.'.') GOTO GATOM8
1695 	IF (DPCOL.NE.0) GOTO GATOM5
1705 	DPCOL=ICOL
1715 	GOTO GATOM6
1725 GATOM5,	ERRCOD=2
1735 	CALL FATALB
1745 GATOM6,	CALL GETCH
1755 	GOTO GATOM1
1765 ;
1775 ;END OF ATOM
1785 ;
1795 GATOM8,	ACOL2=ICOL
1805 	ATOMSZ=ACOL2-ACOL1
1815 	IF (LETSW.EQ.SPACE) GOTO GATM10
1825 	ATMTYP=1
1835 	WORD=
1845 	IF (ATOMSZ.LE.6) GOTO GATOM9
1855 	ATOMSZ=6
1865 GATOM9,	WORD=INLINE(ACOL1,ACOL1+ATOMSZ-1)
1875 	ERRCOD=3
1885 	IF (DPCOL.NE.0) CALL FATALA
1895 	GOTO GATM30
1905 ;
1915 ;IT IS EITHER A NUMERIC LITERAL, OR NULL
1925 ;
1935 GATM10,	IF (ATOMSZ.EQ.0) RETURN
1945 	ATMTYP=3
1955 	IF (DPCOL.EQ.0) GOTO GATM11
1965 	ATOMSZ=ATOMSZ-1
1975 GATM11,	ERRCOD=5
1985 	IF (ATOMSZ.LE.0) GOTO GATM15
1995 ;
2005 	ERRCOD=4
2015 	IF (ATOMSZ.GT.015) GOTO GATM15
2025 	IF (DPCOL.EQ.0) GOTO GATM14
2035 	J=1
2045 	I=DPCOL-ACOL1
2055 	IF (I.EQ.0) GOTO GATM13
2065 	NUMLIT(J,I)=INLINE(ACOL1,DPCOL-1)
2075 	J=J+I
2085 GATM13,	IF (J.GT.ATOMSZ) GOTO GATM30
2095 	NUMLIT(J,ATOMSZ)=INLINE(DPCOL+1,ACOL2-1)
2105 	ATOMDP=ACOL2-DPCOL-1
2115 	GOTO GATM30
2125 GATM14,	NUMLIT(1,ATOMSZ)=INLINE(ACOL1,ACOL2-1)
2135 	ATOMDP=
2145 	GOTO GATM30
2155 ;
2165 GATM15,	CALL FATALA
2175 	ATOMSZ=1
2185 	DPCOL=
2195 	ATOMDP=
2205 	NUMLIT(1,1)=1
2215 	GOTO GATM30
2225 ;
2235 ;IT IS AN NON-NUMERIC LITERAL
2245 ;
2255 GATM20,	ATMTYP=4
2265 	I=1
2275 	ERRCOD=10
2285 GATM21,	IF (ICOL.GE.INLSIZ) GOTO GATM24
2295 	CALL GETCH
2305 	IF (ICHAR.NE.SQUOTE) GOTO GATM21
2315 	INCR ACOL1
2325 	ATOMSZ=ICOL-ACOL1
2335 	CALL SCANF
2345 	ERRCOD=4
2355 	IF (ATOMSZ.GT.ALFMAX) GOTO GATM24
2365 	IF (ATOMSZ.GT.0) RETURN
2375 	ERRCOD=5
2385 GATM24,	CALL FATALA
2395 	ATOMSZ=1
2405 	GOTO GATM30
2415 ;
2425 ;FINISH UP
2435 ;
2445 GATM30,	IF (ICHAR.EQ.SPACE) CALL SCANF
2455 	IF (ICHAR.LT.'0') GOTO GATM31
2465 	IF (ICHAR.LE.'9') GOTO GATM32
2475 	IF (ICHAR.LT.'A') RETURN
2485 	IF (ICHAR.GT.'Z') RETURN
2495 	GOTO GATM32
2505 GATM31,	IF (ICHAR.EQ.';') GOTO GATM33
2515 	IF (ICHAR.EQ.'.') GOTO GATM32
2525 	IF (ICHAR.NE.SQUOTE) RETURN
2535 GATM32,	ICOL=ICOL-1
2545 	GOTO GATM34
2555 GATM33,	EOL='X'
2565 GATM34,	ICHAR=SPACE
2575 	RETURN
2585 ;
2595 ; SCAN A PICTURE
2605 ;
2615 SCANP,	CALL SCANF
2625 	ACOL1=ICOL
2635 	GOTO SCANP2
2645 SCANP1,	CALL GETCH
2655 SCANP2,	IF (ICHAR.NE.SPACE) GOTO SCANP1
2665 	ATOMSZ=ICOL-ACOL1
2675 	IF (ATOMSZ.LE.PICMAX) GOTO SCANP3
2685 	ERRCOD=3
2695 	CALL FATALA
2705 	ATOMSZ=PICMAX
2715 SCANP3,	EOL='X'
2725 	RETURN
2735 ;
2745 ;FIND FIRST NON-BLANK INPUT CHARACTER
2755 ;
2765 SCANF,	CALL GETCH
2775 	IF (ICHAR.NE.SPACE) RETURN
2785 	IF (EOL.EQ.SPACE) GOTO SCANF
2795 	RETURN
2805 ;
2815 ;GET NEXT INPUT CHARACTER
2825 ;
2835 GETCH,	IF (EOL.NE.SPACE) GOTO GETCH3
2845 	INCR ICOL
2855 	IF (ICOL.GT.INLSIZ) GOTO GETCH2
2865 	ICHAR=INLINE(ICOL,ICOL)
2875 	RETURN
2885 GETCH2,	EOL='X'
2895 GETCH3,	ICHAR=SPACE
2905 	RETURN
2915 ;
2925 ; CREATE PICTURE FOR DECIMAL ITEM
2935 ;
2945 BLDPIC,	IF (J.LE.15) GOTO BLDPC1
2955 	J=15
2965 BLDPC1,	K=1
2975 	J=J-DATADP
2985 	IF (J.LE.0) GOTO BLDPC2
2995 	J=PICMSP(J)
3005 	LISTPC(1,J)=PICMSK(20-J,19)
3015 	K=J+1
3025 BLDPC2,	IF (DATADP.EQ.0) GOTO BLDPC4
3035 	J=DATADP
3045 	LISTPC(K,K)='.'
3055 	INCR K
3065 BLDPC3,	LISTPC(K,K)='X'
3075 	INCR K
3085 	J=J-1
3095 	IF (J.GT.0) GOTO BLDPC3
3105 BLDPC4,	LISTPC(K,K)='-'
3115 	LISTIS=K
3125 	RETURN
3135 ;
3145 ;DETERMINE WIDTH OF HEADING
3155 ;
3165 HWIDTH,	LISTNH=1
3175 	LISTHW=
3185 	J=1
3195 	K=1
3205 HWID1,	IF (LISTIT(J,J).NE.'*') GOTO HWID3
3215 	INCR LISTNH
3225 	K=J-K
3235 	IF (K.LE.LISTHW) GOTO HWID2
3245 	LISTHW=K
3255 HWID2,	K=J+1
3265 HWID3,	INCR J
3275 	IF (J.LE.ATOMSZ) GOTO HWID1
3285 	IF (LISTNH.LE.NUMHDR) RETURN
3295 	NUMHDR=LISTNH
3305 	RETURN
3315 ;PUT ERROR CODE IN TABLE
3325 ;
3335 SYNTAX,	ERRCOD=1
3345 	GOTO FATALB
3355 FATALA,	ERRCOL=ACOL1
3365 	GOTO FATAL
3375 FATALB,	ERRCOL=ICOL
3385 FATAL,	INCR FATALI
3395 	INCR FATALC
3405 	IF (FATALI.GT.ERRMAX) RETURN
3415 	FATALM(1,3)=ERRCOD
3425 	FATALM(4,6)=ERRCOL
3435 	FATALE(FATALI)=FATALM
3445 	RETURN
3455 ;
3465 ;OPEN UP FIRST SYS FILE
3475 ;
3485 OPNSYS,	ON ERROR NOSYS
3495 	INIT (1,SYS)
3505 	FINI (1)
3515 	ON ERROR NOSYS
3525 	INIT (1,SYS)
3535 	RETURN
3545   
3555 NOSYS,	XMIT (8,"?NO SOURCE FILES')
3565 	STOP