ASMB,R,L,C
      HED %PTP 91704-16112 REV A * (C) HEWLETT-PACKARD CO. 1976 
      NAM %PTP,7 91704-16112 REV A 760316 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
******************************************************************
      SPC 2 
* 
********************************************* 
* 
*%PTP PROGRAM TO PROGRAM INTERFACE FOR SCE-4
* 
*SOURCE PART #      91704-18114 
* 
*REL PART #         91704-16114 
* 
*WRITTEN BY:        LARRY POMATTO 
* 
*DATE WRITTEN:      11-13-74
* 
*MODIFIED BY:       CHUCK WHELAN
* 
*DATE MODIFIED:     DEC 1975
* 
**********************************************
      SPC 1 
      SUP 
* 
*     SUBROUTINE TO HANDLE PROGRAM TO PROGRAM MASTER
*     CALLS IN THE RTE/B TERMINAL 
*     THIS PROGRAM USES THE RFAIN PARMB AND REPLY BUFFERS 
* 
      SPC 2 
* 
*     DEFINE EXTERNALS
      EXT DIMCK,.4,%TAM,.ENTR,.1,M2,EXEC,PRMB,M6
      EXT SBYTE,ABYTE,.8,M1,.2
      EXT DIMFG,.3,B377,M3,INDCK
      EXT .10,%MOVE,MSTFL,MSTB,CLU
      SPC 2 
* 
*     DEFINE ENTRY POINTS 
      ENT POPEN,PREAD,PWRIT,PCONT 
      ENT GET,FINIS,ACEPT,REJCT 
      SPC 2 
* 
*     DEFINE A AND B REG
A     EQU 0 
B     EQU 1 
      SKP 
* 
*     HERE ON POPEN CALL
*     CALLING SEQUENCE
*     CALL POPEN(PCB,ERROR,NAME,LU,TAG) 
*     LU IS CURRENTLY IGNORED...
* 
POPEN NOP 
      JSB PMOV      GO MOVE PRAMS 
      OCT 1         DEFINE FOR POPEN
      SPC 1 
* 
*     HERE ON PREAD 
*     CALLING SEQUENCE
*     CALL PREAD(PCB,ERROR,BUFFER,BUF LEN,TAG)
* 
PREAD NOP 
      JSB PMOV      GO MOVE THE PRAMS INTO THE PARMB
      OCT 2         DEFINE FOR READ 
      SPC 2 
* 
*     HERE FOR PWRIT
*     CALLING SEQUENCE
*     SAME AS PREAD 
* 
PWRIT NOP 
      JSB PMOV
      OCT 3         DEFINE AS PWRIT 
      SPC 2 
* 
*     HERE FOR PCLOSE 
*     CALLING SEQUENCE
*     CALL PCLOS(PCB,ERROR,TAG) 
* 
PCONT NOP 
      JSB PMOV
      OCT 4         DEFINE FOR PCLOS
      SKP 
* 
*     HERE IS WHERE ALL THE ROUTINES COME TO HAVE THEIR 
*     PRAMS MOVED INTO THE PARMB
*     CALLING SEQUENCE
*     NOP RETURN ADDRESS (CALLING ROUTINE)
*     JSB PMOV
*     OCT XX        FUNCTION CODE 
* 
PMOV  NOP 
      LDA PRMBA     GET ADDRESS OF PRMB IN FRAIN
      JSB INDCK     CHASE DOWN INDIRECTS
      STA PRMBA     SO WE DON'T HAVE TO AGAIN 
      STA CPRMA     SAVE IN COUNTER 
      ADA D33 
      STA TITAG     SAVE ADDR OF 1ST TIME-TAG 
      INA 
      STA TITAG+1   SAVE ADDR OF 2ND TIME-TAG 
      LDA .4        GET STREAM TYPE 
      JSB STWRD     SAVE STREAM TYPE
      CLA 
      JSB STWRD     SET SUB STREAM TO ZERO
      LDA PMOV      GET ADDRESS 
      ADA M2        OF ROUTINE THAT CALLED US 
      LDA A,I       GET RETURN ADDRESS
      STA RTRN
      JMP ENTR      GO GET CALLING PRAMS
* 
*     DEFINE LOCATIONS FOR PRAMS PASSED BY CALL 
* 
PRM1  NOP 
PRM2  NOP 
PRM3  NOP 
PRM4  NOP 
PRM5  NOP 
RTRN  NOP 
ENTR  JSB .ENTR     GET PRAMS 
      DEF PRM1
      LDA PMOV,I    GET FUNCTION CODE 
      JSB STWRD     SAVE FUNCTION CODE
      CPA .1        IS IT A POPEN?
      JSB POPN      YES, MOVE NAME TO PCB 
      CLA 
      JSB STWRD     MOVE ZERO INTO RESERVED WORDS 
      JSB STWRD 
* 
*     MOVE PCB TO PARMB 
      LDA PRM1
      STA TEMP1     ADDR OF PCB 
      LDA M3
      STA TEMP2     COUNTER 
MPCB1 LDA TEMP1,I   GET WORD FROM PCB 
      JSB STWRD     SAVE IN PARMB 
      ISZ TEMP1     BUMP ADDR 
      ISZ TEMP2      & COUNTER
      JMP MPCB1     ITERATE 
* 
      LDA PMOV,I    GET FUNCTION CODE 
      ADA BRTBL     GO TO CORRECT ROUTINE 
      JMP A,I       AWAY WE GO
      SPC 1 
BRTBL DEF *,I 
      DEF POPN1 
      DEF PRED
      DEF PWRT
      DEF PCLS
      SPC 2 
* 
*     HERE ON CLOSE COMMAND 
* 
PCLS  LDA PRM3      GET ADDRESS OF TAG FIELD
      STA PRM5      SAVE TAG FIELD ADDRESS FOR REPLY
POPN1 LDA PRM5      GET ADDR OF TAG FIELD 
      LDB CPRMA     GET DESTINATION ADDRESS OF TAG MOVE 
      JSB MTAGO     MOVE TAG FIELD
      JMP WREQ      NOW WRITE REQUEST 
      SKP 
* 
*     HERE FOR PREAD
* 
PRED  CLB,INB,RSS   PREAD 
* 
*     HERE FOR PWRIT
* 
PWRT  LDB .2        PWRIT 
      STB REQDA     SAVE DATA DIRECTION 
      LDA PRM5      GET ADDRESS OF TAG FIELD
      LDB CPRMA     GET ADD OF DESTINATION OF TAG 
      JSB MTAGO     GO MOVE TAG TO PARMB
      LDB M71       SET FOR LENGTH ERROR
      LDA PRM4,I    GET LENGTH OF DATA BUFFER 
      SZA           CHECK FOR ZERO OR 
      SSA           NEGATIVE
      JMP ERR       HE BLEW IT
      LDB PRMBA     GET TO DATA LENGTH WORD 
      ADB .18 
      STA B,I       SAVE LENGTH 
      LDA REQDA     GET DATA DIRECTION FLAG 
      CPA .2        IS IT A WRITE COMMAND?
      JMP WREQ      YES...DON'T CHECK BOUNDS
      LDA PRM3      GET LOWER LIMIT 
      LDB PRM3
      ADB PRM4,I    GET UPPER LIMIT+1 
      ADB M2        GET UPPER LIMIT 
      JSB DIMCK     CHECK LIMIT 
* 
*     HERE WE SEND REQUEST
* 
WREQ  CLA,CCE       SET FOR SEND REQ. ONLY
      JSB %TAM      GO DO IT
      DEF PRMB
      DEF PRMBA 
      SKP 
* 
*     AT THIS POINT WE HAVE SENT THE REQUEST
*     AND HAVE RECEIVED THE REPLY 
* 
      CPA B1        ALL OK? 
      JMP CMPL1     YES 
DVERR LDB M51       SET FOR DRIVER ERROR
      AND B377
      CPA B100      PARITY ERROR? 
      LDB M52       YES 
*     ERROR RETURN
ERR   STB PRM2,I    SET IN ERROR CODE 
      JMP RTRN,I    AND RETURN
* 
CMPL1 LDB PRMBA     GET ADDRESS OF REPLY BUFFER 
      ADB .3        GET TO STATUS WORD
      LDB B,I       GET ERROR WORD
      STB PRM2,I    SAVE ERROR STATUS 
      SSB           ANY ERRORS? 
      JMP RTRN,I    YES...DON'T PROCESS FURTHER 
      LDB PRMBA     GET ADDRESS OF REPLY
      ADB .2        GET TO TYPE CODE
      LDA B,I       GET TYPE CODE 
      RAR,RAR       MOVE IN ERROR CODE
      AND .1        MASK ALL BUT REJECT CODE
      STA PRM2,I    SAVE STATUS 
      LDA B,I       GET TYPE CODE AGAIN 
      AND B17       MASK OFF ALL BUT TYPE CODE
      ADA CMPLB     GET TO COMPLETION ROUTINE 
      JMP A,I       GO TO ROUTINE 
      SPC 2 
CMPLB DEF *,I 
      DEF COPN      CODE=1 OPEN ACCEPT
      DEF RDAT      CODE=2 READ ACCEPT
      DEF WDAT      CODE=3 CWRIT ACCEPT 
      DEF CCLOS     CODE=4 CONTROL ACCEPT 
      DEF COPN      CODE=5 OPEN REJECT
      DEF TAGIT     CODE=6 READ REJECT
      DEF TAGIT     CODE=7 WRITE REJECT 
      DEF CCLOS     CODE=8 CONTROL REJECT 
      SPC 3 
* 
*     HERE FOR POST PROCESSING OF OPEN
* 
COPN  LDB PRMBA     GET ADDRESS OF REPLY BUFFER 
      ADB .5         GET TO 3 WORD PCB
      STB TEMP1     SAVE SOURCE ADDRESS 
      LDB M3        GET COUNT 
      STB TEMP2     SAVE IN DOWN COUNTER
      LDB PRM1      GET DESTINATION ADDRESS 
COPN1 LDA TEMP1,I   GET SOURCE WORD 
      STA B,I       SAVE WORD 
      INB           GET NEXT DESTINATION ADDRESS
      ISZ TEMP1     GET NEXT SOURCE ADDRESS 
      ISZ TEMP2     DONE? 
      JMP COPN1     NO...CONTINUE 
      JMP TAGIT     MOVE TAG FIELD
* 
*  ACCEPTED PREAD POST-PROCESSING 
* 
RDAT  CLA,INA,RSS   A=1 FOR READ DATA 
* 
*  ACCEPTED PWRIT POST-PROCESSING 
* 
WDAT  LDA .2        A=2 FOR WRITE DATA
      STA TEMP2 
      LDA B300      SEND/RCV DATA ONLY
      IOR CLU        + LU 
      STA CNWD      SET DRIVER CONTROL WORD 
* 
      JSB EXEC      CALL DRIVER TO XFER DATA
      DEF *+7 
      DEF TEMP2 
      DEF CNWD
      DEF PRM3,I    DATA BUFFER 
      DEF PRM4,I    DATA LENGTH 
TITAG NOP 
      NOP 
* 
      SLA,RSS       ANY DRIVER ERRORS?
      JMP DVERR     YES 
* 
* 
*  MOVE TAG FIELD TO USER AREA AND EXIT 
* 
TAGIT LDB PRM5      GET ADDRESS WHERE TO PUT TAG FIELD
CCLS1 LDA PRMBA     GET ADDRESS OF REPLY BUFFER 
      ADA .8        GET TO TAG FIELD
      JSB MTAG      MOVE TAG BACK TO USER AREA
      JMP RTRN,I    GO BACK TO USER 
      SPC 2 
* 
*     HERE FOR POST PROCESSING OF CLOSE 
* 
CCLOS LDB PRM3      GET ADDRESS OF TAG FIELD
      JMP CCLS1     GO TO COMPLETION
      SPC 4 
PRMBA DEF PRMB
D33   DEC 33
D35   DEC 35
CPRMA NOP 
REQDA NOP 
TEMP1 NOP 
TEMP2 NOP 
B1    OCT 1 
B17   OCT 17
.5    DEC 5 
.18   DEC 18
M46   DEC -46 
M47   DEC -47 
M71   DEC -71 
M51   DEC -51 
M52   DEC -52 
B100  OCT 100 
B300  OCT 300 
SPACE ASC 1,
DUMMY NOP 
      SKP 
* 
*     SUBROUTINE TO MOVE NAME TO PCB AREA 
* 
POPN  NOP 
      LDA PRM3,I    GET PROGRAM NAME LENGTH 
      AND B377      MASK OFF ASC FLAG 
      LDB A         MOVE INOT B REG 
      CMB,INB       NEGATE CHAR COUNT 
      STB PPNS3     SAVE FOR MOVE 
      LDB A         GET POSITIVE LENGTH AGAIN 
      ADA M6        CAN NOT BE OVER 5 CHARS LONG
      ADB M1        MUST BE AT LEAST 1 CHAR LONG
      SSB,RSS 
      SSA,RSS 
      JMP NMERR     NAME NOT IN RANGE...ERROR 
      LDA PRM1      GET PCB ADDRESS 
      LDB A         GET UPPER LIMIT 
      ADB .2
      JSB DIMCK     CHECK FOR RANGE 
      LDA PRM1      GET PCB ADDRESS AGAIN 
      STA PPNS1     SAVE FOR LOOP 
      LDA SPACE     GET TWO SPACE CHARACTERS
      LDB M3        GET LENGTH OF PCB 
PPNSA STA PPNS1,I   SAVE SPACE WORD 
      ISZ PPNS1     GET TO NEXT LOCATION
      INB,SZB       DONE? 
      JMP PPNSA     NO
      LDA PRM1      GET PCB ADDRESS AGAIN 
      CLE,ELA       CONVERT TO BYTE ADDRESS 
      STA PPNS1     SAVE FOR MOVE 
      ISZ PRM3      GET PAST LENGTH WORD
      LDA PRM3      GET ADDRESS OF NAME 
      CLE,ELA       CONVERT TO BYTE ADDRESS 
      STA PRM3      SAVE FOR MOVE 
PPNSB LDB PRM3      GET BYTE ADDRESS SOURCE 
      JSB ABYTE     GET CHARACTER 
      LDB PPNS1     GET BYTE ADDRESS DESTINATION
      JSB SBYTE     SAVE BYTE 
      ISZ PPNS1     INC SOURCE BYTE ADDRESS 
      ISZ PRM3      INC DESTINATION BYTE ADDRESS
      ISZ PPNS3     DONE? 
      JMP PPNSB     NO
      JMP POPN,I    YES...RETURN TO MAIN LINE CODE
      SPC 1 
PPNS3 NOP 
PPNS1 NOP 
      SPC 2 
* 
*     HERE IF NAME ERROR OCCURED
* 
NMERR LDB M71       NAME ERROR CODE 
      JMP ERR       GO PROCESS ERROR
      SKP 
* 
*     SLAVE PROGRAM TO PROGRAM READY CALL 
*     CALLING SEQUENCE
*     CALL GET(ICLASS,IERR,IFUN,ITAG,IL)
* 
RCLSA NOP 
RERA  NOP 
RFUNA NOP 
RTAGA NOP 
RILA  NOP 
GET   NOP 
      JSB .ENTR 
      DEF RCLSA 
      LDA MSTFL     GET LENGTH OF MASTER REQUEST
      SZA,RSS       IS THERE ONE? 
      JMP RDYER     NO...ERROR
      LDA MSTBA     GET BUFFER ADDRESS OF PARMB 
      JSB INDCK     DIRECT IT 
      STA MSTBA 
      ADA .5        SEE IF FIRST TIME 
      CLB 
      CPB 0,I       IF ZERO...ALREADY ISSUED A READY
      JMP RDYER     ERROR 
      STB A,I       CLEAR WORD
      ADA .3        GET TO TAG FIELD ADDRESS
      LDB RTAGA     SET TO STORE IT 
      JSB MTAG      MOVE TAG FIELD
      LDB MSTBA     GET PARMB ADDRESS AGAIN 
      ADB .2        GET TO FUNCTION CODE
      LDA B,I       GET FUNCTION CODE 
      AND .3        MASK OFF ALL BUT FUNCTION CODE
      STA RFUNA,I   SAVE FUNCTION CODE
      ADB .16       GET TO LENGTH WORD
      LDA B,I       GET LENGTH WORD 
      STA RILA,I    SAVE LENGTH WORD
      CLB,RSS       SET FOR ALL OK ERROR RETURN 
RDYER LDB M46       SET FOR IMPROPER SEQUENCE 
      STB RERA,I    SAVE ERROR STATUS 
      JMP GET,I     RETURN
      SPC 1 
.16   DEC 16
      SKP 
* 
*     PROGRAM TO PROGRAM ACCEPT CALL
*     CALLING SEQUENCE
*     CALL ACEPT(ITAG,IERR,IBUF)
* 
ATAGA NOP 
AERRA NOP 
ABUFA NOP 
ACEPT NOP 
      JSB .ENTR 
      DEF ATAGA 
      LDA AERRA 
      STA PRM2      ADDR OF ERROR PARAMETER 
      LDA ACEPT 
      STA RTRN      RETURN ADDR 
      LDA MSTBA     CHECK IF READY ISSUED 
      ADA .5        GET TO FLAG WORD
      LDA A,I       GET FLAG WORD 
      SZA           READY ISSUED? 
      JMP JERR      NO...SEQUENCE ERROR 
      LDA ATAGA     GET ADDRESS OF TAG SOURCE 
      LDB MSTBA     GET ADDRESS OF DESTINATION
      ADB .8        GET TO TAG AREA 
      JSB MTAGO 
      LDB MSTBA     GET BUFFER ADDRESS AGAIN
      ADB .2        GET TO FUNCTION CODE
      LDB 1,I       GET FUNCTION CODE 
      CLA 
      RBR,SLB       TEST FOR PREAD OR PWRIT 
      RSS           IT IS, SKIP 
      JMP ARPLY     POPEN OR PCONT, DO REQ. ONLY
      LDA MSTBA     GET PRMB BUFFER ADDRESS 
      ADA .18       ADDR OF LENGTH WORD 
      STA BFLEN     SAVE LENGTH ADDR
      LDA B100      CODE FOR SEND REQ/ READ DATA
      SSB,RSS       SKIP IF PWRIT 
      ALS           ELSE CODE FOR SEND REQ/ SEND DATA 
ARPLY LDB BIT14     SET FOR NO ERRORS 
* 
*     A REG HAS MODE FOR DRIVER OPERATION 
*     B REG ORED INTO REPLY FUNCTION CODE WORD
* 
SRPLY IOR CLU       A HAS MODE + LU 
      STA CNWD      DRIVER CONTROL WORD 
      LDA RPLBT     BITS 7 AND 2
      IOR B         OR IN ACCEPT REJECT BITS
      LDB MSTBA     GET PARMB ADDRESS 
      ADB .2        GET TO FUNCTION CODE WORD 
      IOR B,I       OR IN REPLY RESPONSE
      STA B,I       SAVE REPLY
      INB           GET TO ERROR STATUS 
      CLA           AND CLEAR IT OUT
      STA B,I 
      ADB .2        GET TO FIRST WORD OF NAME 
      STB B,I       SET FIRST WORD NON ZERO 
      LDA MSTB      GET STREAM TYPE 
      IOR B1411     SET IN REPLY BIT-FRIENDLY BIT 
      STA MSTB      SAVE STREAM WORD
      LDA M10 
      STA RTRY      SET RETRY COUNTER 
*     CALL DRIVER TO SEND REPLY 
SNDR  JSB EXEC      SEND REPLY
      DEF *+7 
      DEF .2
      DEF CNWD
MSTBA DEF MSTB
      DEF D35       LENGTH OF REQUEST 
      DEF ABUFA     ADDR OF DATA BUFFER 
BFLEN DEF DUMMY     LENGTH OF DATA
* 
      STA LSTAT     SAVE LINE STATUS
      SLA,RAR 
      JMP GOOD      NO ERRORS 
      SWP 
      AND B40 
      CLE,ERB 
      SEZ,SZA,RSS 
      JMP FAIL      DRIVER ERROR
      SEZ,RSS 
      JMP BZWT      REMOTE IS BUSY
      SZA           SIMULTANEOUS REQUEST? 
      JMP SNDR      YES, TRY AGAIN
* 
BZWT  ISZ RTRY      BUMP RETRY COUNTER
      JMP *+3       OK TO RETRY 
* 
FAIL  LDA LSTAT     OPERATION FAILED
      JMP DVERR 
* 
      LDA DLAY
      INA,SZA       DELAY ABOUT 50 MSECS
      JMP *-1 
      JMP SNDR      RETRY 
* 
GOOD  RAR,RAR       RIGHT JUSTIFY "STOP RCVD" BIT 
      RAR,SLA 
      JMP RCSTP     STOP RECEIVED, RETURN -47 
      CLB           CLEAR OUT LENGTH WORD 
      STB MSTFL     INCASE ANOTHER READY ISSUED 
      STB PRM2,I    SAVE GOOD ERROR STATUS
      JMP RTRN,I    RETURN
* 
RCSTP LDB M47       RETURN ERROR CODE 
      JMP ERR 
      SPC 1 
M10   DEC -10 
RTRY  NOP 
LSTAT NOP 
DLAY  DEC -12500
B40   OCT 40
BIT14 OCT 40000 
B1411 OCT 44000 
RPLBT OCT 204 
CNWD  NOP 
      SKP 
* 
*     PROGRAM TO PROGRAM REJECT CALL
*     CALLING SEQUENCE
*     CALL REJCT(ITAG,IERR) 
* 
JTAGA NOP 
JERRA NOP 
REJCT NOP 
      JSB .ENTR 
      DEF JTAGA 
      LDA JERRA 
      STA PRM2      ADDR OF ERROR PARAMETER 
      LDA REJCT 
      STA RTRN      RETURN ADDR 
      LDB MSTBA     GET PARMB ADDRESS 
      ADB .5        GET TO FLAG WORD
      LDA B,I       IS FLAG WORD SET? 
      SZA 
      JMP JERR      NO...ERROR...NO READY CALL
      LDB MSTBA     GET DESTINATION BUFFER ADDRESS
      ADB .8
      LDA JTAGA     GET SOURCE ADDRESS
      JSB MTAGO     MOVE TAG FOR REPLY
      CLA           SET FOR REQUEST ONLY
      LDB BIT15     GET REJECT BIT
      JMP SRPLY     GO SEND REPLY & EXIT
* 
*  SEQUENCE ERROR OCCURRED
JERR  LDB M46       -46= SEQUENCE ERROR 
      JMP ERR       RETURN WITH ERROR STATUS
      SPC 1 
BIT15 OCT 100000
      SKP 
* 
*     SUBROUTINE TO KEEP THE SYSTEM COMPATABLE
*     FINIS         IS USED ONLY AT CENTRAL CURRENTLY 
*     CALLING SEQUENCE
*     CALL FINIS(ANY THING) 
* 
FINIS NOP 
      ISZ FINIS     GET TO RETURN ADDRESS 
      JMP FINIS,I   AND RETURN
      SPC 5 
* 
*     SUBROUTINE TO STORE A WORD IN TO THE PARMB
*     CALLING SEQUENCE
*     JSB STWRD 
*     A REG CONTAINS THE WORD 
*     CPRMA CONTAINS ADDRESS WHERE TO STORE THE WORD
*         CPRMA IS INCREMENTED AFTER WORD IS STORED 
* 
STWRD NOP 
      STA CPRMA,I   SAVE WORD 
      ISZ CPRMA     GET TO NEXT WORD
      JMP STWRD,I   RETURN
      SKP 
* 
*     SUBROUTINE TO MOVE TAG FIELD
*     CALLING SEQUENCE
*     JSB MTAG
*     A REG CONTAINS ADD OF SOURCE TAG FIELD
*     B REG CONTAINS ADD OF DESTINATION TAG FIELD 
* 
MTAG  NOP 
      STA MTAGA     SAVE SOURCE ADDRESS 
      STB MTAGB     SAVE DESTINATION ADDRESS
      LDA B         GET ENDING ADDRESS
      ADB .8
      JSB DIMCK     GO CHECK
      LDA MTAGA     GET SOURCE ADDRESS
      LDB .10       GET LENGTH
      JSB %MOVE     MOVE THE BUFFER 
MTAGB NOP 
      JMP MTAG,I    AND RETURN
      SPC 2 
MTAGA NOP 
      SPC 2 
* 
*     SUBROUTINE TO MOVE TAG TO PCB 
* 
MTAGO NOP 
      ISZ DIMFG     SET FOR SPECIAL 
      JSB MTAG
      JMP MTAGO,I   AND RETURN
END   EQU * 
      END 
                                                          