/PROGRAMMIERUNGSROUTINE FUER PROMS


*1000

INIT,	CLA CLL
	DCA OCNU
 	TLS
     RTCHAR
     CHOCT
     TYDER                    /NO OCTAL DIGIT
	JMS SRREOC
     RTCHAR
     CHOCT
     TYDER
	JMS SRREOC
     RTCHAR
     CHOCT
     TYDER
	JMS SRREOC
     TAD OCNU
     JMS NCHECK
	ADDRES
    TAD OCNU
	CHECK
	0000
	TYDER		/NUMBER =0 !
     CIA
     DCA ADDCNT
	RCHAR
	JMS SRRBOT
	31

PROGRM, TDC
        4302
        4320
        4316
        4320
        4316
        4320
        4316
        4320
        4316
         306
        ISZ ADDCNT
        SKP
        JMP END
        TDC
	4211
        4302
        4320
        4320
        4320
        4320
        4320
        4320
        4320
	4320
         306
	LINE
        ISZ ADDCNT
        JMP PROGRM
END,	JMS SRRBOT
	31
	HLT
	CIF CDF 0
	JMP I .+1
	400




/           *********READ AN OCTAL NUMBER *********
/              CALL:REOCT
/		CHARACTER IN ACC
/              RETURNS WITH ACC. UNCHANGED
SRREOC,	0
        DCA CHAR
	TAD OCNU
	CLL RAL
	RTL
	DCA OCNU
	TAD CHAR
	AND MASK
	TAD OCNU
        DCA OCNU
       JMP I SRREOC
MASK,  0007




/            ********* CHECK A NUMBER IF GREATER THEN 
/                    XXX TYPE A DIAGNOSTIC ERROR *********
/               CALL:   NCHECK
/               XXX IN ACC
/               RETURNS WITH ACC. UNCHANGED
NCHECK,      0
           DCA ZCHAR
           TAD I NCHECK
	DCA TEMI
	TAD I TEMI
           DCA NUMBER
           ISZ NCHECK
           TAD ZCHAR
           CIA
           TAD NUMBER
           SPA CLA
           TYDER               / NUMBER>  400
           TAD ZCHAR
           JMP I NCHECK
ADDCNT,	0
OCNU,	0
M25,	-31
CHAR,	0
ZCHAR,	0
NUMBER,	0
ADDRES,	400
TEMI,	0


/	*********TYPE A SPECIFIC NUMBER OF RUBOUTS ********
/	CALL:SRRBOT
/	NUMBER OF RUBOUTS
/	RETURNS WITH ACC =0


SRRBOT,	0
	CLA
	TAD I SRRBOT
	CIA
	DCA COUNT
	TAD Z377
	TCHAR
	ISZ COUNT
	JMP .-2
	CLA
	ISZ SRRBOT
	JMP I SRRBOT


Z377,	377
COUNT,	0



$$$$$$$$$$$$$$$$$$$$$$$$$$$