SUBROUTINE PUNCH (CODE, ADDR, NBYTES) INTEGER CODE, ADDR, NBYTES INTEGER CHAR INTEGER CHMASK INTEGER CR, LF INTEGER CRLF INTEGER BLANK, PERIOD INTEGER BLANKS, DASHES, COLONS, SLASHS INTEGER ACH, BCH, CCH, DCH, ECH, FCH INTEGER GCH, HCH, ICH, JCH, KCH, LCH INTEGER MCH, NCH, OCH, PCH, QCH, RCH INTEGER SCH, TCH, UCH, VCH, WCH, XCH INTEGER YCH, ZCH INTEGER LBRACE, RBRACE INTEGER LBRACK, RBRACK INTEGER ICLP04 COMMON /CHARAC/ CHAR COMMON /CHARAC/ CHMASK COMMON /CHARAC/ CR, LF COMMON /CHARAC/ CRLF COMMON /CHARAC/ BLANK, PERIOD COMMON /CHARAC/ BLANKS, DASHES, COLONS, SLASHS COMMON /CHARAC/ ACH, BCH, CCH, DCH, ECH, FCH COMMON /CHARAC/ GCH, HCH, ICH, JCH, KCH, LCH COMMON /CHARAC/ MCH, NCH, OCH, PCH, QCH, RCH COMMON /CHARAC/ SCH, TCH, UCH, VCH, WCH, XCH COMMON /CHARAC/ YCH, ZCH COMMON /CHARAC/ LBRACE, RBRACE COMMON /CHARAC/ LBRACK, RBRACK COMMON /CHARAC/ ICLP04 INTEGER ECODE INTEGER CMCHAN INTEGER RBCHAN INTEGER OBCHAN INTEGER MPCHAN INTEGER DBCHAN INTEGER TTYIN INTEGER TTYOUT COMMON /IODEFN/ ECODE COMMON /IODEFN/ CMCHAN COMMON /IODEFN/ RBCHAN COMMON /IODEFN/ OBCHAN COMMON /IODEFN/ MPCHAN COMMON /IODEFN/ DBCHAN COMMON /IODEFN/ TTYIN COMMON /IODEFN/ TTYOUT INTEGER GCHAR INTEGER OBJECT (136) INTEGER SUM, DBYTE, SEMI, I, TEMP DATA SEMI /59/ C WRITE (DBCHAN, 1) CODE, ADDR, NBYTES C 1FORMAT (' ENTER PUNCH WITH ', 3I5) IF (.NOT. (NBYTES.GT.255))GO TO 13072 CALL ERROR (8) RETURN 13072 CONTINUE CALL SET (BLANKS, OBJECT, 136) CALL PCHAR (OBJECT, 1, SEMI) CALL EHX (NBYTES, OBJECT, 2,3) IF (.NOT. (NBYTES.LE.0))GO TO 13074 CALL WRLIN (OBCHAN, OBJECT, 4) RETURN 13074 CONTINUE CALL EHX (ADDR, OBJECT, 4,7) SUM = NBYTES SUM = SUM + GCHAR (ADDR, 1) SUM = SUM + GCHAR (ADDR, 2) DO 13076 I = 1, NBYTES DBYTE = GCHAR (CODE, I) CALL EHX (DBYTE, OBJECT, 2*I+6, 2*I+7) SUM = SUM + DBYTE 13076 CONTINUE CALL EHX (SUM, OBJECT, 2*NBYTES+8, 2*NBYTES+11) CALL WRLIN (OBCHAN, OBJECT, 2*NBYTES + 12) CALL USEMEM (ADDR, NBYTES) C WRITE (DBCHAN, 2) C 2FORMAT (' EXIT PUNCH') RETURN END