ASMB,R,Q,C
      NAM CMX2L,3,99 24999-16295 REV.2024 
      HED CMX2L EXTERNAL INTERFACE ROUTINES (IO)
      SUP PRESS EXTRA LISTING 
* 
*PROGRAM SECTION AND ROUTINES TO
*ESTABLISH COMMUNICATION TO USER
*AND HIS FILES. 
* 
      EXT CLOSE,LOGLU,EXEC,OPENF,LOCF,CREAT,NAMR
      EXT GETST,PNAME,REIO
A     EQU 0 
B     EQU 1 
CMX2L NOP 
      JSB LOG       GET LOG DEVICE
      DEF OPRLU     SAVE IN OPRLU 
      JSB GETST     GET COMMAND STRING
      DEF *+4 
      DEF STRNG     CHAR BUF FOR INPUT FROM TERM
      DEF N80       UP TO 80 CHARS IN BUF 
      DEF ERRTN     ERROR FLAG
      LDB ERRTN     PUT LENGTH OF STRING IN B LIKE EXEC 
      STB SLONG     LENGTH IN CHARS OF ACTUAL READ
      STB PRMTF     SET PROMPT FLAG 
*                   NO PROMPT IF ANY COMMAND LINE PARMS 
      LDA P1        INITIAL PARSE START POINT 
      STA ISTRC 
* 
*PUT PROGRAM INVOCATION NAME ON TERMINAL MESSAGE LINES
* 
      JSB PNAME 
      DEF *+2 
      DEF PNBUF 
* 
*NOW THAT HAVE NAME PUT IN *CMX2L MESSAGES
* 
      LDA N8
      JSB COPY
      DBR CMX1+1
      DBR CMX2+1
      DBR CMX3+1
      DBR CMX4+1
      DBR CMX5+1
      DBR CMX6+1
      DBR CMX7+1
* 
*GET INPUT FILE NAME AND MOVE TO FILE BUF AREA
* 
      JSB GTIN      INPUT ROUTINE AND PARSER OF FILES 
      DEF FILE1     6 WORD BUF FOR FILENAME FTYPE SC CR 
      DEF PRIN      PROMPT MSG START IF NOT IN COMMAND LINE 
* 
*OPEN INPUT FIRST 
* 
      JSB OPNIN 
* 
* GET LIST FILE NAME AND MOVE TO BUFFER AREA
* 
      JSB GTIN
      DEF FILE3 
      DEF PRLST 
* 
*OPEN LIST FILE 
* 
      JSB OPLST 
* 
* GET OUTPUT FILE NAME AND MOVE TO BUFFER AREA
* 
      JSB GTIN
      DEF FILE2 
      DEF PROUT 
* 
* OPEN OUTPUT FILE
* 
      JSB OPOUT 
* 
*OPEN INPUT INCLUDES TYPE CHECK AND REPROMPT FOR SOME ERRORS
* 
* 
*OPEN LIST FILE 
* 
*SAME ROUTINE AS OPEN OUTPUT
* 
* 
*OPEN OUTPUT INCLUDES CHECK FOR SAME AS INPUT (REPROMPT)
*     PROMPT FOR OVERWRITE, AND TYPE CHECK
*     REPROMPT OCCURS EXCEPT FOR FMP ERRORS 
* 
* 
*BEGIN MAIN BODY OF PROGRAM HERE
* 
      SPC 3 
      ENT OPRLU 
      ENT CMX1,CMX2,CMX3,CMX4,CMX5,CMX6,CMX7
      ENT @NMX1,@NMX2,@NMX3,@NMX4,@NMX5,@NMX6 
      ENT @NMX7,FLERR,PMSGT,FILE1,IDCB1,IERR1 
      ENT FILE2,ODCB2,IERR2,BRCE
      EXT MANLP 
      EXT READF,INLNG,INBUF 
      ENT FILE3,LDCB3,IERR3 
      EXT @BINB 
      JSB MANLP 
* 
*END OF PROGRAM NORMAL CLOSE
* 
EXIT  JSB CLOS2     EXIT FROM PROGRAM 
      JSB EXEC
      DEF *+2       EXIT TO SYSTEM
      DEF P6
      HED GETIN ROUTINE TO GET FILE NAMES FROM TERMINAL 
* 
*GETIN
* OPERAND 1 ADDRESS TO STORE FILENAME TYPE SC CR
* OPERAND 2 PROMPT MESSAGE TO USE IF NULL STRING ON INPUT 
*      NO DEFAULTS ALLOWED
* 
GTIN  NOP 
      LDA GTIN,I    FIRST PARM ADDRESS
      ISZ GTIN      STEP TO SECOND PARM 
      LDB GTIN,I    SECOND PARM ADDRESS 
      ISZ GTIN      SET TO RETURN ADDRESS 
      STA @FIL      SAVE FILEBUF ADDRESS
      STB @MSG      SAVE MESSAGE ADDRSS 
* 
*NOINPUT REPROMPT FOR INPUT FROM TERM 
* 
NOIN  LDA PRMTF     ALLOW DEFAULT 0 LU IF NO PARM GIVEN 
      SZA           AND NO PROMPT ALLOWED 
      JMP GTLP      DO NOT PROMPT FOR PARM
      LDA P1        RESET PARSE CHAR COUNT
      STA ISTRC 
      JSB PMSGT     PRINT PROMPT
      DEF @MSG,I
      JSB RDTRM     READ TERMINAL RESPONSE
GTLP  JSB NAMRR     PARSE INSTRING
      SSA 
      JMP GTIN,I    RETURN USING DEFAULT IF NO PARM GIVEN 
      LDA IPBUF+3   SEE IF NULL PARM WAS INPUT
      SZA,RSS 
      JMP GTIN,I    RETURN USING DEFAULT IF NO PARM GIVEN 
      LDA ADIPB     MOVE FILENAME TYPE SC CR (6 WORDS)
      LDB @FIL
       JSB .MVW 
      DEF P6
      NOP 
      LDB @FIL
      ADB P3        MASK FOR 2 LSB'S OF TYPE
      LDA B,I 
      AND =B3 
      STA B,I 
      JMP GTIN,I    NORMAL RETURN 
      HED READ TERMINAL ROUTINE 
* 
* READS TERMINAL INTO STRNG 
* 
RDTRM  NOP
      JSB REIO      READ TERMINAL INTO STRING 
      DEF *+5 
      DEF P1
      DEF OPRLU 
      DEF STRNG 
      DEF N80       80 CHARS MAX
      STB SLONG     STORE LENGTH IN SLONG 
      JMP RDTRM,I 
* 
*LOG ROUTINE
* 
LOG   NOP 
      JSB LOGLU     GET THE TERMINAL LU 
      DEF *+2 
      DEF DUMMY 
      IOR M400      MERGE ECHO BIT FOR TERM IO
      LDB LOG,I     SAVE AT OPERAND 1 
      STA B,I 
      ISZ LOG       SET TO RETURN ADDRESS 
      JMP LOG,I     RETURN
DUMMY DEC 0 
* 
*NAMRR ROUTINE TO PARSE INPUT FILENAMES 
* 
NAMRR NOP 
      JSB NAMR
      DEF *+5 
      DEF IPBUF 
      DEF STRNG 
      DEF SLONG 
      DEF ISTRC     SHOULD BE SET TO 1 FOR FIRST CALL 
      JMP NAMRR,I   RETURN
      HED OPEN INPUT FILE 
* 
*OPEN INPUT FILE AND VERIFY TYPE 3 OR 4 IF NOT LU 
* LU IS OK USE OPENF
* 
OPNIN NOP 
      JSB OPENF     OPEN INPUT
      DEF *+7 
      DEF IDCB1     INPUT DATA CONTROL BLOCK
      DEF IERR1     INPUT FILE ERROR FLAG 
      DEF FILE1     FILE NAME 
      DEF OPTIN     OPEN OPTION INPUT B610
      DEF F1SC      SECURITY
      DEF F1DSC     CARTRIGE
      SSA,RSS       ANY ERRORS
      JMP TYPIN     NO CHECK TYPE OF FILE 
      JSB FLERR     FLERR NEVER RETURNS!
      DEF FILE1     FILENAME CAUSING ERROR PARM 
TYPIN JSB CKINP     CHECK INPUT FOR ASMB LINE 
      JMP OPNIN,I   ASMB LINE FOUND NORMAL RETURN 
      JSB CLOSE     CLOSE FILE CAUSING TYPE ERROR 
      DEF *+2 
      DEF IDCB1 
      JSB PMSGT     PRINT NO ASMB LINE ERROR MESSAGE
      DEF ASMBM 
      LDA P0        RESET CHAR COUNT TO FORCE 
      STA ISTRC     READ ON NEW DATA BY PARSE 
      LDB PRMTF     IF NOT PROMPTING THEN 
      SZB 
      JMP EXIT      EXIT
*                   ELSE PROMPT 
      JSB GTIN
      DEF FILE1 
      DEF PRIN      INPUT FILE PROMPT MESSAGE 
      JMP OPNIN+1   RETRY OPEN INPUT
      HED OPEN OUTPUT 
* 
*OPEN OUTPUT FILE 
* CHECK FOR SAME NAME AS INPUT
*   REPROMPT IF SAME NAME 
* CHECK FOR ALREADY EXISTS
*   PROMPT FOR GO AHEAD IF EXISTS 
* CHECK FOR FILE TYPE OF 3 OR 4 OR 0 (LU ONLY)
*   REPROMPT IF TYPE ERROR
* ANY FMP ERROR NOT EXPECTED EXIT PROGRAM 
* 
OPOUT NOP 
* INIT NUMBER OF BLOCKS TO ZERO TO SIGNAL 
* CLOSE ROUTINE TYPE OF CLOSE TO USE
* IF OUTFILE IS NEW 
*    ALLOCATE ALL AVAILABLE SPACE TO IT 
*    AND ON CLOSE TRUNCATE TO ACTUAL FILE SIZE
* IF OUTFILE IS OLD 
*    USE EXTENTS FOR EXTRA LENGTH AND USE NORMAL
*    CLOSE
* 
      LDA P0
      STA OBLKS 
*INPUT = OUTPUT CHECK 
      LDA F2        USE COMPARE WORDS INSTRUCTION 
      LDB F1
       JSB .CMW 
      DEF P3        INCLUDE ONLY NAME IN THIS CHECK 
      NOP 
      JSB EQUAL     NOT LEGAL 
      NOP           NOT EQUAL OK
* 
*MAKE SURE NOT SAME AS LIST FILE
* 
      LDA F2
      LDB F3
       JSB .CMW 
      DEF P3        SEE IF NAMES MATCH
      NOP 
      JSB EQU2L     GO CHECK CARTRIGE NUM'S 
      NOP           NOT EQUAL OK
      JSB OPENF     OPEN OUTPUT FILE MAY BE AN LU 
      DEF *+7 
      DEF ODCB2 
      DEF IERR2     ERROR FLAG FOR OUT FILE 
      DEF FILE2     FILE NAME 
      DEF OUTPN     OUTPUT FILE  OPTIONS B610 
      DEF F2SC      SECURITY
      DEF F2DSC     CARTRIGE
      SSA,RSS             CHECK ERROR RETURN
      JMP TST2      NO ERROR ON OPEN CHECK TYPE AND PROMPT
      CPA N6        SEE IF FILE NOT FOUND 
      JMP CRET      CREATE IF FILE NOT PRESENT YET
      JSB FLERR     ELSE FATAL ERROR FLERR EXITS WITHOUT RETURN 
      DEF FILE2     FILE NAME PARM
CRET  JSB CREAT     CREATE FILE SHOULD BE NON EXISTANT
      DEF *+8 
      DEF ODCB2     OUTPUT DATA CONTROL BLOCK 
      DEF IERR2     OUTPUT ERROR FLAG 
      DEF FILE2     OUTPUT FILE NAME
      DEF P20       SIZE = 20 BLOCKS TO START 
      DEF P4        FILE TYPE = SOURCE
      DEF F2SC      SECURITY CODE 
      DEF F2DSC     CARTRIGEW 
      SSA,RSS             ERROR OR NUMBER OF BLOCKS/2 
      JMP NOERR 
      JSB FLERR     FATAL FILE ERROR
      DEF FILE2     FILE NAME PARM
NOERR CLE,ERA       A NOW = BLOCKS
      STA OBLKS     SAVE TOTAL BLOCKS ALOCATED FOR CLOSE ROUTINE
      JMP OPOUT,I   NORMAL RETURN 
TST2  CPA P0        IF TYPE ZERO FILE 
      JMP OPOUT,I 
      CPA P3
      JMP OPRMT     PROMPT OVERWRITE OF EXISTANT FILE 
      CPA P4
      JMP OPRMT     PROMPT OVERWRITE OF EXISTANT FILE 
      JSB CLOSE     CLOSE FILE WITH TYPE ERROR
      DEF *+2 
      DEF ODCB2     OUTPUT DATA CONTROL BLOCK 
      JSB TYMSG     PRINT TYPE ERROR MESSAGE
      DEF FILE2     FILE NAME PARAMETER 
      LDA P0        FORCE NEW INPUT 
      STA ISTRC 
* 
*PROMPT ONLY IF PROMPT FLAG 0 
* 
      LDB PRMTF 
      SZB 
      JMP EXIT      ELSE EXIT PROGRAM 
      JSB GTIN      GET NEW OUTPUT FILENAME 
      DEF FILE2 
      DEF PROUT     PROMPT MESSAGE
      JMP OPOUT+1   RETRY OUTPUT OPEN 
* 
*PROMPT OVERWRITE 
* 
* 
*SEE IF PROMPT FLAG SET BEFORE PRINTING PROMPT
* 
OPRMT LDA PRMTF 
      SZA           IF 0 THEN PROMPT
      JMP OPOUT,I   FLAG NOT SET RETURN 
* 
*THEN PROMPT BEFORE OVERWRITING 
* 
      LDA F2        PUT FILENAME IN PROMPT MESSAGE
      LDB @OVRT 
       JSB .MVW 
      DEF P3
      NOP 
      JSB PMSGT     PRINT MESSAGE 
      DEF OVRWT 
      JSB RDTRM     READ RESPONSE 
      LDA @BSTR     SEE IF RESPONSE YES 
      LDB @BYES 
       JSB .CBT 
      DEF P3        ONLY 3 CHARS CHECKED REMAINDER IGNORED
      NOP 
      JMP OPOUT,I   YES NORMAL RETURN EXISTANT FILE 
      NOP 
      JSB CLOSE     CLOSE FILE WE DON'T WANT
      DEF *+2 
      DEF ODCB2     OUTPUT DATA CONTROL BLOCK 
      LDA P0        FORCE NEW INPUT 
      STA ISTRC 
      JSB GTIN      GET NEW OUTPUT FILE 
      DEF FILE2 
      DEF PROUT     MESSAGE FOR PROMPT
      JMP OPOUT+1   RETRY OPEN OF OUTPUT
* 
*EQUAL RESTART
* 
* 
*EQUAL INPUT = OUTPUT 
* 
EQUAL NOP 
* 
*SEE IF CART NUM'S EQUAL
* 
      LDA FILE2     IF FILE IS 0 LU ALLOW IT
      SZA,RSS 
      JMP EQUAL,I   ALLOW ZERO LU 
      LDA F2DSC     COMPARE CART OF OUT AND IN
      CPA F1DSC 
      JMP EQERR     IF EQUAL THEN ERROR HAS OCCURED 
      SZA,RSS       CANNOT ALLOW DEFAULT OF EITHER CART NUM 
      JMP EQERR 
      LDA F1DSC 
      SZA,RSS 
      JMP EQERR 
      JMP EQUAL,I   UNIQUE CART NUM'S YEA 
* 
*IF ANY OF THE FILES IS A DUPLICATE 
*THE RESULT IS EITHER AN INFINITE LOOP
*(INPUT = OUT OR LIST) OR GARBAGE 
*(OUT=LIST) 
*PRINT ERROR AND PREVENT THIS CONDITION 
* 
EQERR JSB PMSGT     PRINT ERROR MESSAGE 
      DEF EOFIN     MESSAGE FOR EQUAL 
* 
*EXIT PROGRAM 
* 
      JMP EXIT
* 
*HANDLE OUT = LIST CASE 
* 
EQU2L NOP 
      LDA FILE2 
      SZA,RSS       IF 0 LU ALLOW 
      JMP EQU2L,I 
      LDA F2DSC 
      CPA F3DSC     COMPARE CART NUM OF OUT AND LIST
      JMP EQERR     IF EQUAL ERROR
* 
*NEITHER CART NUM CAN BE DEFAULT 0
* 
      SZA,RSS 
      JMP EQERR 
      LDA F3DSC 
      SZA,RSS 
      JMP EQERR 
      JMP EQU2L,I   DIFF CART NUM'S OK! 
      HED OPEN LIST FILE ROUTINE
* 
*OPEN LIST   FILE 
* CHECK FOR SAME NAME AS INPUT
*   REPROMPT IF SAME NAME 
* CHECK FOR ALREADY EXISTS
*   PROMPT FOR GO AHEAD IF EXISTS 
*   AND NOT GIVEN ON THE COMMAND LINE 
* CHECK FOR FILE TYPE OF 3 OR 4 OR 0 (LU ONLY)
*   REPROMPT IF TYPE ERROR
* ANY FMP ERROR NOT EXPECTED EXIT PROGRAM 
* 
OPLST NOP 
* INIT NUMBER OF BLOCKS TO ZERO TO SIGNAL 
* CLOSE ROUTINE TYPE OF CLOSE TO USE
* IF OUTFILE IS NEW 
* IF OUTFILE IS OLD 
*    USE EXTENTS FOR EXTRA LENGTH AND USE NORMAL
*    CLOSE
* 
      LDA P0
      STA OBLKS 
*INPUT = OUTPUT CHECK 
      LDA F3        USE COMPARE WORDS INSTRUCTION 
      LDB F1
       JSB .CMW 
      DEF P3        INCLUDE ONLY NAME IN THIS CHECK 
      NOP 
      JSB EQULA     NOT LEGAL 
      NOP           NOT EQUAL OK
      JSB OPENF     OPEN OUTPUT FILE MAY BE AN LU 
      DEF *+7 
      DEF LDCB3 
      DEF IERR3     ERROR FLAG FOR OUT FILE 
      DEF FILE3     FILE NAME 
      DEF OUTPN     OUTPUT FILE  OPTIONS B610 
      DEF F3SC      SECURITY
      DEF F3DSC     CARTRIGE
      SSA,RSS             CHECK ERROR RETURN
      JMP TST2A     NO ERROR ON OPEN CHECK TYPE AND PROMPT
      CPA N6        SEE IF FILE NOT FOUND 
      JMP CRETA     CREATE IF FILE NOT PRESENT YET
      JSB FLERR     ELSE FATAL ERROR FLERR EXITS WITHOUT RETURN 
      DEF FILE3     FILE NAME PARM
CRETA JSB CREAT     CREATE FILE SHOULD BE NON EXISTANT
      DEF *+8 
      DEF LDCB3     OUTPUT DATA CONTROL BLOCK 
      DEF IERR3     OUTPUT ERROR FLAG 
      DEF FILE3     OUTPUT FILE NAME
      DEF P20       SIZE = 20 BLOCKS TO START 
      DEF P4        FILE TYPE = SOURCE
      DEF F3SC      SECURITY CODE 
      DEF F3DSC     CARTRIGEW 
      SSA,RSS             ERROR OR NUMBER OF BLOCKS/2 
      JMP NORRE 
      JSB FLERR     FATAL FILE ERROR
      DEF FILE3     FILE NAME PARM
NORRE CLE,ERA       A NOW = BLOCKS
      STA OBLKS     SAVE TOTAL BLOCKS ALOCATED FOR CLOSE ROUTINE
      JMP OPLST,I   NORMAL RETURN 
TST2A CPA P0        IF TYPE ZERO FILE 
      JMP OPLST,I 
      CPA P3
      JMP OPMRT     PROMPT OVERWRITE OF EXISTANT FILE 
      CPA P4
      JMP OPMRT     PROMPT OVERWRITE OF EXISTANT FILE 
      JSB CLOSE     CLOSE FILE WITH TYPE ERROR
      DEF *+2 
      DEF LDCB3     OUTPUT DATA CONTROL BLOCK 
      JSB TYMSG     PRINT TYPE ERROR MESSAGE
      DEF FILE3     FILE NAME PARAMETER 
      LDA P0        FORCE NEW INPUT 
      STA ISTRC 
* 
*PROMPT ONLY IF PROMPT FLAG IS 0
* 
      LDB PRMTF 
      SZB 
      JMP EXIT      EXIT IF NO PROMPT TO BE DONE
      JSB GTIN      GET NEW OUTPUT FILENAME 
      DEF FILE3 
      DEF PRLST     PROMPT MESSAGE
      JMP OPLST+1   RETRY OUTPUT OPEN 
* 
*PROMPT OVERWRITE   IF NECESSARY
* 
* 
*SEE IF PROMPT FLAG SET BEFORE PRINTING PROMPT
* 
OPMRT LDA PRMTF 
      SZA           IF FLAG 0 THEN PROMPT 
      JMP OPLST,I   FLAG NOT SET RETURN 
* 
*THEN PROMPT BEFORE OVERWRITING 
* 
      LDA F3        PUT FILENAME IN PROMPT MESSAGE
      LDB @OVRT 
       JSB .MVW 
      DEF P3
      NOP 
      JSB PMSGT     PRINT MESSAGE 
      DEF OVRWT 
      JSB RDTRM     READ RESPONSE 
      LDA @BSTR     SEE IF RESPONSE YES 
      LDB @BYES 
       JSB .CBT 
      DEF P3        ONLY 3 CHARS CHECKED REMAINDER IGNORED
      NOP 
      JMP OPLST,I   YES NORMAL RETURN EXISTANT FILE 
      NOP 
      JSB CLOSE     CLOSE FILE WE DON'T WANT
      DEF *+2 
      DEF LDCB3     OUTPUT DATA CONTROL BLOCK 
      LDA P0        FORCE NEW INPUT 
      STA ISTRC 
      JSB GTIN      GET NEW OUTPUT FILE 
      DEF FILE3 
      DEF PRLST     MESSAGE FOR PROMPT
      JMP OPLST+1   RETRY OPEN OF OUTPUT
* 
*EQUAL RESTART
* 
EQULA NOP 
      LDA FILE3     IF NULL ALLOW 
      SZA,RSS 
      JMP EQULA,I 
      LDA F3DSC     SEE IF CART NUMS DIFF 
      CPA F1DSC 
      JMP EQERR     IF EQUAL ERROR AND EXIT 
      SZA,RSS       NEITHER CART CAN BE DEFAULT 0 
      JMP EQERR 
      LDA F1DSC 
      SZA,RSS 
      JMP EQERR 
      JMP EQULA,I   UNIQUE CART NUM'S OK!!
      HED TYMSG AND FLERR AND CNV99 
* 
*TYMSG TYPE ERROR MESSAGE 
* 
TYMSG NOP 
      LDA TYMSG,I   GET FILENAME ADDRESS WORD 
      ISZ TYMSG     STEP TO RETURN POINT
      LDB @SBPT     ADDRESS OF SUBSTITUTION POINT 
       JSB .MVW 
      DEF P3        PUT FILE NAME IN MESSAGE
      NOP 
      JSB PMSGT     PRINT MODIFIED MESSAGE
      DEF EOFTY     TYPE ERROR MESSAGE
      JMP TYMSG,I   NORMAL RETURN 
@SBPT DEF EOFTY+4   SUBSTITUTION POINT IN MSG FOR FILENAME
@OVRT DEF OVRWT+7   SUBSTITUTION POINT IN MSG FOR FILENAME
* 
*FLERR PROGRAM PRINTS FMGR ERROR MSG
* EXITS FROM PROGRAM BACK TO SYSTEM 
* 
FLERR NOP           USE JSB CALL TO PASS PARMS
      CMA,INA       MAKE ERROR POSITIVE 
      JSB CNV99     CONVERT TO 2 DIGIT ASCII
      STA EMGR+4    STORE IN ERROR NUMBER IN MSG
      LDA FLERR,I   GET FILE NAME ADDRESS 
LP33  SSA,RSS       RESOLVE INDIRECT IF PRESENT 
      JMP OK33
      ELA,CLE,ERA   CLEAR INDIRECT BIT
      LDA A,I 
      JMP LP33
OK33  LDB @SUBP     ADDRESS WHERE TO STORE
       JSB .MVW 
      DEF P3        PUT FILENAME IN MESSAGE 
      NOP 
      JSB PMSGT     PRINT ERROR MESSAGE 
      DEF EMGR
      JSB CLOS2     CLOSE ALL FILES 
      JSB EXEC      RETURN TO SYSTEM
      DEF *+2 
      DEF P6
@SUBP DEF EMGR+10   POINT IN MESSAGE FOR FILENAME 
* 
*CNV99
* 
CNV99 NOP 
      CLB 
      DIV P10 
      SZA 
      ADA M20 
      ADA M40       FORCE LEADING BLANK IF ZERO 
      ALF,ALF       PUT IN LEFT HALF
      IOR B 
      IOR M60       PUT IN CODE FOR ZER0 CHAR 
      JMP CNV99,I   RETURN ASCII IN A REG 
      HED CLOSE ALL FILES FOR THIS PROGRAM
* 
*CLOS2
* NORMAL CLOSE INPUT
* TRUNCATE CLOSE OF OUTPUT IF CREATED BY PROGRAM
* NORMAL CLOSE OF OUTPUT IF ALREADY PRESENT WHEN PROG RUN 
* 
CLOS2 NOP 
      JSB CLOSE     CLOSE INPUT 
      DEF *+2 
      DEF IDCB1     INPUT DATA CONTROL BLOCK
* 
*CLOSE LISTING
* 
      JSB CLOSE     CLOSE LISTING 
      DEF *+2 
      DEF LDCB3 
* 
*CLOSE OUTPUT 
* 
      JSB CLOSE 
      DEF *+2 
      DEF ODCB2 
*RETURN 
      JMP CLOS2,I 
      HED PRINT MESSAGE ON THE TERMINAL PMSGT 
* 
*PMSGT THIS ROUTINE PRINTS MESSAGES ON THE TERMINAL 
* OPERAND 1 ADDRESS OF START OF MESSAGE FIELD 
* 
* MESSAGE FIELD 
*   1 WORD LENGTH OF MESSAGE IN WORDS 
*   MESSAGE IN ASCII FORM 
* 
PMSGT NOP 
      LDA PMSGT,I   GET ADDRESS OF MESSAGE FIELD
      ISZ PMSGT     STEP TO RETURN ADDRESS
RSLP  SSA,RSS       RESOLVE ANY INDIRECT ADDRESS PARMS TO 
*                   ALLOW INDEXING OF MESSAGE!
      JMP RSVD      RESOLVED
      ELA,CLE,ERA   CLEAR INDIRECT BIT WANT ADDRESS NOT DATA
      LDA A,I 
      JMP RSLP
RSVD  STA @NMWD     ADDRESS OF NUMBER WORDS IN MESSAGE
      INA 
      STA @DMSG     WORD ADDRESS OF MESSAGE 
* 
*PRINT PROG INVOCATION NAME TO TERMAINAL
* 
      LDA OPRLU 
      IOR =B2000    MERGE NO CRLF ON OUTPUT 
      STA OPLU2 
      JSB REIO      WRITE THE MESSAGE 
      DEF *+5 
      DEF P2        PRINT MESSAGE 
      DEF OPLU2     NO CRLF OPTION
      DEF PNBUF     4 WORDS FOR FILENAME
      DEF P4
      JSB REIO      PRINT MESSAGE 
      DEF *+5 
      DEF P2        PRINT 
      DEF OPRLU 
      DEF @DMSG,I   MESSAGE 
      DEF @NMWD,I   NUMBER WORDS
      JMP PMSGT,I   RETURN
      HED COPY ROUTINE
* 
*COPY PUTS PROG NAME IN *CMX2L MESSAGES 
* 
COPY  NOP 
      STA ICNT      SAVE LOOP COUNTER 
LOOPC ISZ ICNT
      JMP *+2 
      JMP COPY,I    RETURN IF DONE
      LDA @BPNB      GET BYTE ADDRESS OF PROG NAME BUFFER 
      LDB COPY,I    GET BYTE ADDRESS OF DESTINATION 
       JSB .MBT 
      DEF P6        MOVE 6 CHAR PROG NAME TO DEST 
      NOP 
      ISZ COPY      STEP TO NEXT DEST PARM
      JMP LOOPC 
@BPNB DBL PNBUF 
PNBUF ASC 4,CMX2L   EXTRA BLANKS USED BY PMSGT ROUTINE
      HED CHECK FOR ASMB STATEMENT
* 
*CKINP
* 
CKINP NOP 
      JSB READF    READ FIRST LINE OF INPUT 
      DEF *+6 
      DEF IDCB1 
      DEF IERR1 
      DEF INBUF 
      DEF P75 
      DEF LENIN 
      SSA,RSS SEE IF ERROR
      JMP CKASB     NO ERROR
      JSB FLERR     ERROR RETURN
      DEF FILE1 
CKASB LDB LENIN     CHECK FOR ENDFILE 
      SSB 
      JMP ASNFD     ASMB LINE NOT FOUND ON INPUT
      CLE,ELB       CONVERT LENGTH TO CHARS 
      STB INLNG     SAVE INPUT LENGTH IN CHARS
* 
*SEE IF ASMB STARTS STATEMENT 
* 
      LDA @ASMB 
      LDB @BINB     BYTE ADDRESSES TO COMPARE 
       JSB .CBT 
      DEF P4
      NOP 
      JMP ASMFD     FOUND ASMB STATEMENT
      NOP           BAD FILE
* 
*RETURN SKIP ONE FOR ERROR
ASNFD ISZ CKINP 
ASMFD JMP CKINP,I   RETURN
@ASMB DBL AMSBM 
AMSBM ASC 2,ASMB
* 
      HED MESSAGES TO TERM AND FILE 
*TERMINAL MESSAGES
PRIN  DEC 13
      ASC 13,ENTER INPUT:SC:CR OR LU# 
PROUT DEC 13
      ASC 13,ENTER OUTPUT:SC:CR OR LU#
EMGR  DEC 12
      ASC 12,FMGR -XX ON FILE  YYYYYY 
BRCE  DEC  3
      ASC  3,ABORTS 
EOFIN DEC 29
      ASC 18,DUPLICATE FILES OR LU'S NOT ALLOWED. 
      ASC  11, CR MUST BE SPECIFIED 
EOFTY DEC 15
      ASC 15,FILE  XXXXXX NOT TYPE 3 OR 4 
OVRWT DEC 16
      ASC 16, OVERWRITE? XXXXXX ( YES OR NO ) 
ASMBM DEF 15
      ASC 15,'ASMB' NOT STARTING FIRST LINE 
PRLST DEF 14
      ASC 14,ENTER LISTFILE:SC:CR OR LU#
*TERMINAL AND OUTPUT
@NMX1 DEF CMX1+9
CMX1  DEC 11
      ASC 11,*CMX2L ERRORS = XXXX 
@NMX2 DEF CMX2+10 
CMX2  DEC 12
      ASC 12,*CMX2L WARNINGS = XXXX 
@NMX3 DEF CMX3+22 
CMX3  DEC 24
      ASC 24,*CMX2L EXTENDED INSTRUCTION CONVERSIONS = XXXX 
@NMX4 DEF CMX4+19 
CMX4  DEC 21
      ASC 21,*CMX2L FLOATING POINT CONVERSIONS = XXXX 
@NMX5 DEF CMX5+17 
CMX5  DEC 19
      ASC 19,*CMX2L SCIENTIFIC CONVERSIONS = XXXX 
@NMX6 DEF CMX6+18 
CMX6  DEC 20
      ASC 20,*CMX2L FAST FORTRAN CONVERSIONS = XXXX 
@NMX7 DEF CMX7+14 
CMX7  DEC 16
      ASC 16,*CMX2L DMS CONVERSIONS =  XXXXXX 
*DATA AREA
M20   OCT 20
M40   OCT 40
M60   OCT 60
M400  OCT 400 
N1    DEC -1
N6    DEC -6
N8    DEC -8
N80   DEC -80 
P0    DEC 0 
P1    DEC 1 
P2    DEC 2 
P3    DEC 3 
P4    DEC 4 
P6    DEC 6 
P10   DEC 10
P20   DEC 20
P75   DEC 75
BYES  ASC 2,YES 
@BYES DBL BYES
@BSTR DBL STRNG     BYTE ADDRESS OF INSTRING
ADIPB DEF IPBUF 
F1    DEF FILE1 
F2    DEF FILE2 
F3    DEF FILE3 
*VARIABLES
PRMTF NOP           0 IF PROMPT TO TERM IS TO BE USED 
LENIN NOP           INPUT LINE LENGTH IN WORDS ACTUALLY READ
ICNT  NOP           LOOP COUNTER USED BY COPY ROUTINE 
OPLU2 NOP           OUTPUT OPTION FOR PRMSGT
@DMSG NOP           ADDRESS OF MESSAGE SAVE LOC 
@MSG  NOP           ADDRESS OF MESSAGE SAVE LOC 
@FIL  NOP           ADDRESS OF FILE NAME LOC
@NMWD NOP           ADDRESS OF NUMBER OF WORDS IN MESSAGE 
IRB   NOP           FIRST FREE BLOCK IN OUT FILE
IREC  NOP           FIRST FREE REC IN OUT FILE
ITRUN NOP           NUMBER OF BLOCKS TO TRUNCATE
OBLKS NOP           NUMBER OF BLOCKS ALLOCATED AT CREATION
OPRLU DEC 1         TERMINAL LU 
OPTIN OCT 610       OPTION FOR OPEN INPUT 
OUTPN OCT 610       OPTION FOR OPEN OUTPUT
SLONG NOP           LENGTH OF STRNG BUFFER CONTENTS 
*                   IN BYTES
ISTRC DEC 1         NUMBER OF START CHAR FOR NAMR PARSE 
*FILE BUFFERS 
ERRTN NOP           ERROR FLAG FOR TERM INPUT 
IPBUF BSS 40        80 CHAR INPUT BUFFER USED NAMR
STRNG BSS 40        80 CHAR INPUT BUFFER
* 
FILE1 DEC 0         DEFAULT INPUT IS 0 LU (BIT BUCKET)
      NOP 
      NOP 
TYPE1 NOP           NAMR FILE NAME TYPE 
F1SC  NOP           SECURITY CODE 
F1DSC NOP           CARTRIGE
IERR1 NOP           INPUT ERROR FLAG
* 
FILE2 DEC 0         OUT DEFAULT IS BIT BUCKET 
      NOP 
      NOP 
TYPE2 NOP           NAMR FILE NAME PARSE TYPE 
F2SC  NOP 
F2DSC NOP 
IERR2 NOP           OUTPUT ERROR FLAG 
* 
FILE3 DEC 0         LIST DEFAULT IS BIT BUCKET
      NOP 
      NOP 
TYPE3 NOP           NAMR FILE NAME TYPE 
F3SC  NOP           SECURITY CODE 
F3DSC NOP           CARTRIGE
IERR3 NOP           LISTING ERROR FILE
* 
* 
IDCB1 BSS 144       INPUT DATA CONTROL BLOCK
ODCB2 BSS 144       OUTPUT DATA CONTROL BLOCK 
LDCB3 BSS 144       LISTING DATA CONTROL BLOCK
      EXT  .CBT   
      EXT  .CMW   
      EXT  .MBT   
      EXT  .MVW   
      END CMX2L 
ASMB,R,Q,C
*MAIN LOOP OF PROGRAM CMX2L 
* 
*THIS ROUTINE PROCESSES LINES OF INPUT SOURCE AND FORMS OUTPUT
*UNTIL
*     END OF FILE ON INPUT
*     BREAK RECEIVED BY CMX2L 
*     FMP ERROR DURING INPUT OR OUTPUT
*     END STATEMENT ENCOUNTERED IN INPUT SOURCE 
* 
* 
*DO UNTIL ONE OF THE ABOVE CONDITIONS OCCURS
* 
      NAM MANLP 
      ENT MANLP 
      EXT CNUMD,@BINB,ADEXT,CMX1,CMX2,CMX3,CMX4,CMX5
      EXT CMX6,CMX7,@NMX1,@NMX2,@NMX3,@NMX4,@NMX5,@NMX6 
      EXT @NMX7,FILE1,FLERR,IDCB1,IERR1,IFBRK,INBUF,ISTPR 
      EXT OUTPT,PMSGT,PRMPR,READF,SERCH 
      EXT INLNG,OUTML 
      EXT BRCE
      ENT RESA,RESB 
A     EQU 0 
B     EQU 1 
      SUP PRESS PRINTING
MANLP NOP 
* 
*CHECK TO SEE IF BREAK ONE TIME EACH PASS OF LOOP 
* 
      JMP PSTLP     START LOOP FIRST LINE ALREADY READ IN 
*                   BY THE OPEN ROUTINE 
PROGL JSB BREAK 
      JSB READF     READ INPUT LINE INTO INBUF
      DEF *+6 
      DEF IDCB1     INPUT DATA CONTROL BLOCK
      DEF IERR1     INPUT ERROR FLAG
      DEF INBUF     INPUT BUFFER NOTE CURRENTLY CONTAINED 
*                   IN ROUTINE INSTRUCTION PARSE
      DEF P75       MAX INPUT LINE 150 CHARS
      DEF LENIN     ACTUAL WORDS READ -1 IF EOF 
      SSA,RSS       SEE IF ERROR
      JMP CKEOF     OK SEE IF ENDFILE 
      JSB FLERR     EXIT FROM PROGRAM 
      DEF FILE1     PARM FOR FILE NAME CAUSING ERROR
CKEOF LDB LENIN     CHECK FOR END FILE ON INPUT 
      SSB 
      JMP NOEND     ENDFILE OCCURED THEREFORE NO END STATEMENT IN INPUT 
* 
*PARSE INPUT BUFFER FOR INSTRUCTION IF PRESENT
* 
      CLE,ELB       CONVERT TO CHARS OF INPUT FOR PARSE ROUTINE 
      STB INLNG     SAVE LENGTH IN INLNG (CHARS)
PSTLP JSB ISTPR     PARSE INPUT 
* 
*NO INSTRUCTION GO TO WRITE INPUT TO OUTPUT 
* 
      SSB 
      JMP WRLIN 
* 
*IF INSTRUCTION = 'END' THEN GO PROCESS END 
* 
      STB ISTLN     SAVE INSTR LENGTH IN CHARACTERS 
      STA @BIST     SAVE BYTE ADDRESS OF START OF INSTRUCTION 
      CPB P3        SEE IF INSTRUCTION HAS CORRECT LENGTH 
      JMP LNOKE     LENGTH OK CHECK FOR END 
      JMP ISTPC     PROCESS VALID INSTRUCTION 
LNOKE LDB @BEND 
       JSB .CBT 
      DEF P3
      NOP 
      JMP ENDLP     END DETECTED GO FINISH PROCESS
      NOP           ELSE PROCESS INSTRUCTION
* 
*CHECK FOR RPL INSTRUCTION
* 
      LDA @BIST 
      LDB @BRPL 
       JSB .CBT 
      DEF P3        IS INSTRUCTION RPL? 
      NOP 
      JMP RPLHL     YES PROCESS RPL INSTRUCTION 
      NOP           NO
* 
*CHECK FOR EXT INSTRUCTION
* 
      LDA @BIST 
      LDB @BEXT 
       JSB .CBT 
      DEF P3        IS INSTRUCTION EXT
      NOP 
      JMP EXTHL     YES PROCESS EXT INSTRUCTION 
      NOP           NO
* 
*CHECK FOR MIC INSTRUCTION
* 
      LDA @BIST 
      LDB @BMIC 
       JSB .CBT 
      DEF P3
      NOP 
      JSB MICHL     PROCESS MIC WARNING 
      NOP 
* 
*CHECK FOR EMA INSTRUCTION
* 
      LDA @BIST 
      LDB @BEMA 
       JSB .CBT 
      DEF P3
      NOP 
      JSB EMAHL     PROCESS EMA WARNING 
      NOP 
* 
*FIND INSTRUCTION IF PRESENT IN THE INSTRUCTION TABLES
* 
ISTPC LDA @BIST     SET PARM FOR SEARCH ROUTINE 
      JSB SERCH     SEARCH FOR INSTRUCTION IN TABLE 
      DEF ISTLN     PARM OF INSTRUCTION LENGTH
* 
*IF NO INSTRUCTION IS FOUND GOTO WRITE LINE 
* 
      SSA 
      JMP WRLIN 
* 
*INSTRUCTION FOUND SET INSTRUCTION USED MARK
* 
      STB @ISTT     SAVE WORD ADDRESS OF TABLE ENTRY OF INSTRUCTION 
      ADB P4        STEP TO INSTR MARK AND TYPE WORD
      LDA B,I 
      IOR P1        SET INSTR USED MARK 
      STA B,I       SAVE IN TABLE 
      AND =B177400  SELECT INSTRUCTION TYPE FIELD 
      ALF,ALF       PUT IN LOW BYTE 
      AND =B7       MASK FOR CODE SETS LIMIT OF 8 TYPES CURRENTLY 
      ADA EIGNM     USE ADDRESS DISPLACEMENT TO INCREMENT 
*                   CORRECT INSTRUCTION TYPE COUNTER
      LDB A,I 
      INB 
      STB A,I 
* 
*EIGNM ADDRESS OF FIRST ENTRY OF INSTRUCTION TYPE COUNTERS
* 
*IGNM 0 NUMBER EIG INSTRUCTION CONVERTED
*FPNM 1 NUMBER FLOAT INSTRUCTIONS CONVERTED 
*SISNM 2 NUMBER OF SCIENTIFIC INSTRUCTIONS
*FASTF 3 NUMBER OF FAST FORTRAN INSTRUCTIONS
*DMSNM 4 NUMBER OF DMS INSTRUCTIONS CONVERTED 
* 5-7    UNUSED INSTRUCTION TYPES CURRENTLY 
* 
* 
*WRITE LABEL FROM INPUT TO OUTPUT 
* 
*CALC NUMBER OF CHARS IN LABEL
* 
      LDA @BINB 
      CMA,INA 
      ADA @BIST     NUM CHARS IN LABEL IN A NOW 
*                   NOTE DEPENDS ON @BIST POINTING TO SPOT IN 
*                   INPUT BUFFER
      STA NMCAR     SAVE NUMBER OF CHARS IN LABEL 
      LDA @BINB     WRITE LABEL 
      JSB OUTPT 
      DEF P3        START NEW LINE
      DEF NMCAR     NUMBER OF CHARS IN LABEL
* 
*WRITE  SPACE JSB SPACE . 
* 
      LDA @BJSB 
      JSB OUTPT 
      DEF P2        APPEND TO OLD OUTPUT
      DEF P6        6 CHARACTERS
* 
*WRITE INSTRUCTION
* 
      LDA @BIST 
      JSB OUTPT 
      DEF P2        APPEND TO OLD LINE
      DEF ISTLN     NUMBER OF CHARS IN INSTRUCTION
* 
*INIT LOOP TO PROCESS ANY POSSIBLE PARMS THE INSTR MAY HAVE 
* 
      LDA NMCAR 
      ADA ISTLN 
      STA PRSST     CHAR POSITION IN STRING TO START PARM PARSE 
      LDB @ISTT 
      ADB P3        ADDRESS OF NUMBER OF PARMS NEEDED 
      LDA B,I       GET NUMBER OF PARMS AND DUMMIES 
      AND =B377     MASK FOR NUMBER PARMS ONLY
      CMA 
      STA ICNT      SAVE LOOP COUNTER 
      LDA P0
      STA PN        INIT PARM NUMBER FOR ASTERIX FIX ROUTINE
* 
*DO ICNT = -(NUMBER PARMS+1) TO -1 BY 1 
* 
DOLOP ISZ ICNT
      JMP *+2 
      JMP EDLOP     DONE WITH LOOP
      ISZ PN        COUNT PARM NUMBER 
* 
*CALL PARSE PARM
* 
*PNPRM IS ENTRY POINT WHEN ,I FOUND BECAUSE ,I IS NOT COMPLETE PARM 
* 
PNPRM JSB PRMPR 
      DEF INBUF     INPUT BUFFER MUST BE TERMINATED WITH NULL TO STOP SFB IST 
*                   USED BY PARM PARSE ROUTINE
      DEF INLNG     INPUT BUFFER LENGTH IN CHARS
      DEF PRSST     CHARACTER POSSITION OF START OF PARM PARSE
*                   FIRST CHAR POSITION IS 0
      STA @BSTP     SAVE BYTE ADDRESS OF START OF PARM
* 
*CHECK TO SEE IF PARM ACTUALLY FOUND
* 
      SSB 
      JMP NOPRM     NO PARM FOUND 
      STB PRMLN     SAVE PARM LENGTH IN CHARACTERS
* 
*CALL FIX ASTERIX 
* THIS ROUTINE MAKES THE ASTERIX REFER TO THE ORIGINAL
* SOURCE LOCATION 
* THUS PARM 1 * GOES TO *-1 
* AND  PARM 2 * GOES TO *-2 ETC 
* NOTE ROUTINE MOVES PARM TO NEW BUFFER OF 80 CHARS 
* 
      JSB ASTRX 
* 
* 
* SEE IF PARM IS A LITERAL
* 
LITCK LDB @BSTP 
       JSB .LBT 
      CPA =B75      SEE IF FIRST CHARACTER IS = SIGN
      JSB LITHL     IF LITERAL PRINT WARNING MESSAGE
* 
*PUT PARM IN OPERAND FIELD OF DEF STATEMENT 
* 
*WRITE       DEF
* 
      LDA @BDEF 
      JSB OUTPT 
      DEF P1        PRINT OLD START NEW 
      DEF P10       10 CHARACTERS 
* 
*WRITE PARM 
* 
      LDA @BSTP 
      JSB OUTPT 
      DEF P2        APPEND TO OLD OUTLINE 
      DEF PRMLN     PARM LENGTH IN CHARACTERS 
      JMP DOLOP     DO NEXT PARM? 
* 
*NOPARM WHEN ONE EXPECTED 
* 
NOPRM LDA @BEXO     PRINT ERROR MESSAGE 
      JSB OUTPT 
      DEF P1        PRINT OLD START NEW 
      DEF P38       LENGTH OF MESSAGE 
      LDA @BNOP     PRINT NOP STATEMENT 
      JSB OUTPT 
      DEF P5        PRINT ERROR MESSAGE ON LIST ONLY
      DEF P10 
* 
*INCREMENT ERROR COUNT
* 
      ISZ ERCNT 
      JMP DOLOP     DO NEXT PARM? 
@BEXO DBL EXO 
EXO   ASC 19,****ERROR EXPECTING OPERAND: NOP USED
@BNOP DBL NOP 
NOP   ASC 5,      NOP 
* 
*END OF LOOP FOR PARMS FINISH UP
*THIS LINE OF INPUT SOURCE
* 
EDLOP LDA INLNG     IF NOT END OF INPUT WRITE REST OF INPUT 
      CMA,INA 
      ADA PRSST 
      SSA,RSS       IF POS NO MOVE CHARS IN INPUT 
      JMP CKDMY     CHECK FOR NEEDED DUMMY PARMS
* 
*WRITE REST OF INPUT LINE TO OUTPUT 
* 
      CMA,INA       GET POSITIVE NUM CHARS LEFT 
      STA ENLNG     SAVE
      LDA @BINB 
      ADA PRSST     CALC START ADDRESS OF REST OF INPUT 
      JSB OUTPT 
      DEF P2        APPEND
      DEF ENLNG     LENGTH TO ADD 
* 
*CHECK FOR DUMMY PARMS
* 
CKDMY LDA @ISTT     ADDRESS OF TABLE ENTRY START
      ADA P3
      LDA A,I 
      AND =B177400  MASK FOR DUMMY PARMS
      SZA,RSS 
      JMP LSTWR     NO DUMMY ALMOST DONE THIS LINE
* 
*ONLY ALLOW SINGLE DUMMY FOR NOW
*USE NOP STATEMENT FOR DUMMY OP POSSITION 
* 
*WRITE NOP
* 
      LDA @BNOP 
      JSB OUTPT 
      DEF P1        PRINT OLD START NEW 
      DEF P10       TEN CHARS 
* 
*WRITE REMAINING CONSTRUCTED LINE 
* 
LSTWR LDA P0
      JSB OUTPT 
      DEF P0        PRINT OLD 
      DEF P0
* 
*END OF INPUT LINE LOOP GET NEXT LINE 
* 
      JMP PROGL 
      SKP 
* 
*WRITE LINE 
* 
WRLIN LDA @BINB     WRITE INPUT TO OUT UNMODIFIED 
      JSB OUTPT 
      DEF P3        START NEW 
      DEF INLNG     INPUT LINE LENGTH IN CHARS
      LDA P0
      JSB OUTPT 
      DEF P0        PRINT OLD 
      DEF P0
      JMP PROGL     GET NEXT LINE?
      SKP 
*ROUTINES TO FINISH UP
* 
*NOEND GIVES END STATEMENT WHEN NONE FOUND ON INPUT 
* 
NOEND ISZ ERCNT     INCREMENT ERROR COUNT 
* 
*PRINT ERROR MESSAGE ON LIST FILE ONLY
* 
     LDA @BENG     BYTE ADDRESS OF MESSAGE
    JSB OUTPT 
    DEF P3    START NEW LINE DUMP OLD 
    DEF P38    38 CHAR MESSAGE
    LDA P0    PRINT LINE ON LIST ONLY 
    JSB OUTPT 
    DEF P4
    DEF P0
      LDA @ENDS     PUT END STATEMENT INTO INPUT BUFFER 
      LDB @INBF 
      JSB RESA      RESOLVE INDIRECT ADDRESS
      JSB RESB      RESOLVE INDIRECT ADDRESS
       JSB .MVW 
      DEF P5
      NOP 
      LDA P10       SET INPUT BUFFER LENGTH 
      STA INLNG     INPUT BUFFER LENGTH IN CHARS
* 
*NORMAL POINT FOR PROCESSING AFTER DETECTION OF END 
* 
*CALL ROUTINE TO ADD EXT STATEMENTS AS NEEDED 
* 
ENDLP JSB ADEXT 
* 
*CONVERT NUMBERS OF CONVERSIONS ETC TO ASCII
* AND PUT IN MESSAGES FOR TERM AND FILE]
* 
      JSB CNUMD     CONVERT TO DECIMAL
      DEF *+3 
      DEF ERCNT 
      DEF @NMX1,I   ADDRESS WHERE TO STORE ASCII
      JSB CNUMD 
      DEF *+3 
      DEF WRNCT 
      DEF @NMX2,I 
      JSB CNUMD 
      DEF *+3 
      DEF IGNM
      DEF @NMX3,I 
      JSB CNUMD 
      DEF *+3 
      DEF FPNM
      DEF @NMX4,I 
      JSB CNUMD 
      DEF *+3 
      DEF SISNM 
      DEF @NMX5,I 
      JSB CNUMD 
      DEF *+3 
      DEF FASTF 
      DEF @NMX6,I 
      JSB CNUMD 
      DEF *+3 
      DEF DMSNM 
      DEF @NMX7,I 
* 
*PRINT MESSAGES ON TERMINAL AND ON OUTPUT FILE
* 
* PRINT ON TERMINAL 
* 
      JMP BTHPT     PRINT BOTH WITH ONE ROUTINE 
@CMX1 DEF CMX1
@CMX2 DEF CMX2
@CMX3 DEF CMX3
@CMX4 DEF CMX4
@CMX5 DEF CMX5
@CMX6 DEF CMX6
@CMX7 DEF CMX7
* 
*PRINT ON FILE
* 
BTHPT LDA @CMX1 
      JSB OUTML 
      LDA @CMX2 
      JSB OUTML 
      LDA @CMX3 
      JSB OUTML 
      LDA @CMX4 
      JSB OUTML 
      LDA @CMX5 
      JSB OUTML 
      LDA @CMX6 
      JSB OUTML 
      LDA @CMX7 
      JSB OUTML 
* 
*WRITE END STATEMENT LINE 
* 
      LDA @BINB 
      JSB OUTPT 
      DEF P3        START NEW 
      DEF INLNG     NUMBER CHARS
      LDA P0
      JSB OUTPT 
      DEF P0        PRINT OLD LINE
      DEF P0
      JMP MANLP,I   BODY OF PROG DONE 
*                   RETURN TO USER INTERFACE TO CLOSE FILES AND EXIT
* 
*LITERAL HANDLER
* 
LITHL NOP 
      LDA @BWRN     PRINT WARNING MESSAGE 
      JSB OUTPT 
      DEF P1        PRINT OLD START NEW 
      DEF P36       36 CHARS
      ISZ WRNCT     INCREMENT WARNING COUNT 
* 
*THE MESSAGE IS TO PRINT ON LIST FILE ONLY
* 
*FORCE THAT 
* 
      LDA 0 
      JSB OUTPT 
      DEF P5        PRINT OLD START NEW LIST ONLY 
      DEF P0        ZERO CHARS IN NEW STATEMENT 
      JMP LITHL,I   RETURN TO PROCESS AS ORDINARY PARM FOR NOW
@BWRN DBL WRN 
WRN   ASC 18,***WARNING LITERAL IN DEF STATEMENT
@ENDS DEF ENDS+1
ENDS  DEC 5 
      ASC 5,      END 
@BENG DBL ENMG
ENMG  ASC 19,****ERROR NO END STATEMENT; END ADDED
* 
      SKP 
* 
*EMAHL PROGRAM TO PROCESS WARNING MESSAGES FOR EMA
* 
EMAHL NOP 
      LDA @BWEM     GET MESSAGE 
      JSB OUTPT 
      DEF P3
      DEF P50 
      ISZ WRNCT     INCREMENT WARNING COUNT 
* 
*FORCE PRINT ON LIST ONLY 
* 
      LDA P0
      JSB OUTPT 
      DEF P5
      DEF P0
      JMP EMAHL,I   RETURN FROM ROUTINE 
@BWEM DBL EMA 
EMA   ASC 19,***WARNING EMA PSEUDO INSTRUCTION NOT
      ASC 6,IMPLEMENTED 
@BEMA DBL *+1 
      ASC 2,EMA 
* 
*MICHL PROCEDURE FOR HANDLING MIC INSTRUCTION 
* 
MICHL NOP 
      LDA @BWMC 
      JSB OUTPT     PRINT MESSAGE 
      DEF P3
      DEF P55       55 CHARS IN MESSAGE 
      ISZ WRNCT     COUNT WARNING 
* 
*FORCE PRINT LIST ONLY
* 
      LDA P0
      JSB OUTPT 
      DEF P5
      DEF P0
      JMP MICHL,I   RETURN
@BWMC DBL *+1 
      ASC 18,***WARNING MIC PSEUDO INSTUCTION MAY 
      ASC 10, NOT BE IMPLEMENTED
@BMIC DBL *+1 
      ASC 2,MIC 
      SKP 
* 
*SPECIAL FIX ASTERIX PROGRAM
* 
*WORKS FOR PARMS OF UP TO 5 ONLY
* 
ASTRX NOP 
      LDA PRMLN 
      CMA           GET LENGTH PARM 
      STA LPCNT 
      LDB @BSTP     INIT REG FOR CHAR SEARCH
      LDA @BAST 
      STA @DEST 
ASTLP ISZ LPCNT 
      JMP *+2 
      JMP ASTDN     READ WHOLE PARM 
       JSB .LBT 
      CPA ASTX      SEE IF ASTERIX
      JMP AST       DO ASTERIX CASE 
      STB TEMP      DO NORMAL CHAR CASE 
      LDB @DEST 
       JSB .SBT           MOVE CHAR TO OUT BUFFER 
      STB @DEST     SAVE ADDRESS
      LDB TEMP
      JMP ASTLP     DO NEXT CHAR
ASTDN LDA @BAST     SET START OF PARM ADDRESS 
      STA @BSTP 
      JMP ASTRX,I   RETURN
AST   STB TEMP      ASTERIX FOUND 
      LDB @DEST 
       JSB .SBT           PUT ASTERIX IN OUT PARM 
      ISZ PRMLN     INCREASE LENGTH PARM
      ISZ PRMLN 
      LDA PN        CHECK PARM NUMBER 
      AND =B7       MAKE SURE NOT LARGER THAN 7 
      ADA PNAD      FETCH WORD CONTAINING PROPER CHARS
      LDA A,I 
       JSB .SBT           PUT IN MINUS SIGN 
      ALF,ALF 
       JSB .SBT           PUT IN NUMBER ASCII 
      STB @DEST 
      LDB TEMP
      JMP ASTLP     GET NEXT CHAR 
* 
*ASTRIX TABLE 
* 
ASTX  OCT 52        ASTRIX
@BAST DBL ASTBF 
ASTBF BSS 40        80 CHAR PARM BUFFER 
PNAD  DEF PNA+0 
PNA   ASC 8,0-1-2-3-4-5-6-7-
      SKP 
* 
*PROCESS RPL INSTRUCTION
* IF RPL INSTRUCTION IS FOR DEFINEING 
* MICROINSTRUCTION WILL CAUSE ERROR ON
* L SERIES COMPUTERS
* 
RPLHL NOP 
* 
*INIT PARMS FOR PARM PARSE OF LABEL FIELD 
* 
      LDA P0
      STA PRSST     START WITH FIRST CHARACTER
* 
*PARSE PARM FOR LABEL ASSUMPTION IS MADE
*THAT VALID LABEL EXISTS CAN BE DONE
*BECAUSE NO LABEL WILL RESULT IN RPL
*BEING PARSED AS LABEL
* 
      JSB PRMPR 
      DEF INBUF 
      DEF INLNG 
      DEF PRSST 
* 
*SEE IF PARM FOUND
* 
      SSB 
      JMP WRLIN     NO PARM JUST PRINT THIS LINE
      STB PRMLN     SAVE LENGTH OF PARM IN CHARS
* 
*SEARCH TABLE FOR INSTR MATCHING LABEL
* 
*IF LABEL HAS LEADING PERIOD REMOVE IT
* 
      LDB A 
       JSB .LBT           GET FIRST CHAR OF LABEL 
      CPA PERID     IS THE CHAR A PERIOD
      JMP *+2       YES REMOVE IT 
      JMP NOPRD     NO PERIOD CHECK FULL LABEL
*NOTE ONLY VALID IF FULL LABEL INSTRUCTION IS 
*ALOG ALOGT ATAN COS EXP SIN SQRT TAN TANH
*DBLE DDINT SNGL
*ALL OTHER FULL LABEL INSTRUCTIONS ARE DON'T CARES
* 
      LDA PRMLN 
      ADA N1
      STA PRMLN     REDUCE LENGTH OF PARM WHEN ZAP PERIOD 
      JMP CNT44 
NOPRD ADB N1        RESET B  TO TAKE FIRST CHAR OF LABEL
CNT44 LDA B         SET A REG TO START OF LABEL FOR SERCH 
*NOTE A REG SET TO BYTE ADDRESS OF INSTRUCTION TO FIND
      JSB SERCH 
      DEF PRMLN 
      SSA           SEE IF IN TABLE 
      JMP WRLIN     NOT IN TABLE PRINT LINE 
* 
*IF IN TABLE PRINT WARNING MESSAGE ON LIST FILE 
* 
      LDA @BRWN 
      JSB OUTPT 
      DEF P3        START NEW LINE
      DEF P58       LENGTH OF MESSAGE IN CHARS
      LDA P0
      JSB OUTPT     FORCE PRINT OF MESSAGE ON LIST ONLY 
      DEF P4        PRINT OLD ON LIST 
      DEF P0        NO NEW LINE 
      ISZ WRNCT     INCREMENT WARNING COUNT 
      JMP WRLIN     WRITE INPUT LINE (CONTAINS RPL INSTRUCTION) 
* 
*MESSAGE
* 
@BRWN DBL RWN 
RWN   ASC 15,***WARNING RPL MICROCODE CALL
      ASC 14,NOT IMPLEMENTED ON L SERIES
      SKP 
* 
*EXT HANDLER
* 
*PARSES AND PROCESSES OPERANDS OF EXT STATEMENT TO
* PREVENT MULTIPLE DEFINITIONS OF INSTRUCTIONS
* BY ADEXT ROUTINE
* 
EXTHL NOP 
* 
*CALC NUMBER OF CHARS TO SKIP BEFORE PARM PARSE 
* 
      LDA @BINB 
      CMA,INA 
      ADA @BIST     LENGTH OF LABEL + 
      ADA ISTLN     LENGTH OF INSTRUCTION=
      STA PRSST     NUMBER OF CHARS TO SKIP BEFORE PARSING
* 
*DO PARM PASE UNTIL NO MORE PARMS 
* 
PRLOP JSB PRMPR 
      DEF INBUF 
      DEF INLNG 
      DEF PRSST 
*SEE IF PARM FOUND
*WHEN ALL PARMS DONE PRINT EXT LINE UNCHANGED 
* 
      SSB 
      JMP WRLIN     GO WRITE EXT LINE 
      STB PRMLN     IF PARM SAVE LENGTH OF PARM 
* 
*SEE IF PARM BEGINS WITH A PERIOD 
* IF IT DOES DELETE PERIOD FROM PARM AND SEE IF IN
* INSTRUCTION TABLE 
* 
      LDB A         PUT ADDRESS OF PARM START IN B
       JSB .LBT           GET FIRST CHAR OF PARM
      CPA PERID     SEE IF PERIOD 
      JMP *+2       SINCE PERIOD SEE IF IN INSTRUCTION TABLE
      JMP PRLOP     NOT PERIOD GET NEXT PARM
      LDA PRMLN     DELETE PERIOD FROM PARM 
      ADA N1        SUBTRACT 1 FROM LENGTH OF PARM
      STA PRMLN     SAVE NEW LENGTH 
      LDA B         PUT BYTE ADDRESS OF START OF PARM IN A REG FOR SERCH
* 
*SEE IF PARM IS IN INSTRUCTION TABLE
* 
*NOTE A REG SET TO BYTE ADDRESS OF INSTRUCTION TO FIND
      JSB SERCH 
      DEF PRMLN 
      SSA IF NOT IN LIST
      JMP PRLOP     THEN GET NEXT PARM
* 
*WHEN PARM FOUND IN LIST MARK INSTRUCTION USED BYTE 
*TO SHOW THAT EXT ALREADY ISSUED
* 
      ADB P4
      LDA B,I       GET INSTR MARK
      IOR P2        SET EXT DONE BIT
      STA B,I       SAVE BACK IN TABLE
      JMP PRLOP     DO NEXT PARM
      SKP 
* 
*BREAK
* 
* 
BREAK NOP 
      JSB IFBRK     SEE IF BREAK
      DEF *+1 
      SSA 
      JMP EMBR      BREAK RECEIVED
      JMP BREAK,I   NORMAL RETURN 
EMBR  JSB PMSGT     PRINT BREAK MESSAGE 
      DEF BRCE
      JMP MANLP,I   RETURN TO SETUP PROGRAM FOR CLEAN EXIT
* 
*DATA 
*CONSTANTS FIRST
* 
N1    DEC -1
P0    DEC 0 
P1    DEC 1 
P2    DEC 2 
P3    DEC 3 
P4    DEC 4 
P5    DEC 5 
P6    DEC 6 
P58   DEC 58
P10   DEC 10
P36   DEC 36
P38   DEC 38
P50   DEC 50
P55   DEC 55
P75   DEC 75
PERID OCT 56        PERIOD FOR EXTHL ROUTINE
@BDEF DBL DFE 
DFE   ASC 5,      DEF 
@BEND DBL DNE 
DNE   ASC 2,END 
@BJSB DBL BSJ 
BSJ   ASC 3, JSB .
@INBF DEF INBUF 
SPACE OCT 40        SPACE CHARACTER 
@BEXT DBL BEXT
BEXT  ASC 2,EXT 
@BRPL DBL BRPL
BRPL  ASC 2,RPL 
* 
*VARIABLES
* 
EIGNM DEF IGNM      TABLE OF INSTRUCTION TYPE CONVERSIONS 
WRNCT NOP           DO NOT REORDER!!! 
ERCNT NOP 
IGNM  NOP 
FPNM  NOP 
SISNM NOP 
FASTF NOP 
DMSNM NOP 
      NOP           5 EXTRA ENTRIES TO PREVENT ERRORS 
      NOP           6 
      NOP           7 
@BIST NOP           SAVE OF BYTE ADDRESS OF INSTR START 
@BSTP NOP           SAVE OF BYTE ADD OF PARM START
@DEST NOP           TEMP POINTER USED BY ASTRX
@ISTT NOP           SAVE WORD ADD OF INSTR TAB ENTRY
ENLNG NOP           NUM EXTRA CHARS TO ADD TO OUTLINE AFTER 
*                   PARM PARSE
ICNT  NOP           LOOP COUNTER IN GET PARMS LOOP
ISTLN NOP           INSTRUCTION LENGTH IN CHARS 
LENIN NOP           ACTUAL NUM WORDS READ INTO INBUF
LPCNT NOP           LOOP COUNTER FOR ASTERIX ROUTINE
NMCAR NOP           NUMBER CHARS IN A LABEL 
PN    NOP           NUM OF PARM BEING PROCESSED BY PARM LOOP
PRCNT NOP           LOOP COUNTER FOR PRMBL ROUTINE
PRMLN NOP           LENGTH OF PARM GIVEN BY PARM PARSE
PRSST NOP           NUMBER OF CHARS TO SKIP FOR PARM PARSE
TEMP  NOP           TEMPORARY STORAGE OF B REG FOR ASTRX ROUTINE
      SKP 
* 
*RESA RESB ROUTINES TO RESOLVE ADDRESS TO DIRECT ADDRESS
* 
RESA  NOP 
      SSA,RSS 
      JMP RESA,I    RETURN
      ELA,CLE,ERA   ZAP INDIRECT BIT
      LDA A,I 
      JMP RESA+1    KEEP TRYING 
* 
RESB  NOP 
      SSB,RSS 
      JMP RESB,I
      ELB,CLE,ERB   CLEAR INDIRECT BIT
      LDB B,I 
      JMP RESB+1
      EXT  .CBT   
      EXT  .LBT   
      EXT  .MVW   
      EXT  .SBT   
      END 
ASMB,R,L,T,C
      HED INSTRUCTION PARSE 
      NAM ISTPR 
* 
*INSTRUCTION PARSE
* A REGISTER START OF INSTR BYTE ADDRESS RETURNED 
* B REGISTER NUMBER OF CHARS IN INSTRUCTION 
* ON RETURN IF B = -1 NO INSTRUCTION FOUND
*              A NOT USED BECAUSE BYTE ADDRESS
*                MAY SET BIT 15 
* 
* STRING PARSED FOR INSTUCTION IS 
*  INBUF
* LENGTH IS INLNG IN CHARACTERS 
* 
*                   COMMON DATA AREA WITH CALLING ROUTINES
      ENT INBUF,INLNG,@BINB 
      ENT ISTPR 
A     EQU 0 
B     EQU 1 
ISTPR NOP 
      LDA INBUF CHECK FIRST CHARACTER 
      AND =B177400  MASK FOR FIRST CHAR 
      CPA ASTRX     IF ASTRIX IS COMMENT LINE 
      JMP EXIT2     NO INSTRUCTION FOUND
      CPA SPACE 
      JMP SPACF     IF SPACE FIRST NON SPACE START INSTR
LBL   LDA SPC       LABEL FIND FIRST SPACE
      LDB @BINB     SET B TO BYTE ADDRESS OF STRING 
       JSB .SFB           SCAN FOR SPACE NOTE NULL IS END SEARCH MARK 
      JMP SPFND     SPACE FOUND 
      JMP EXIT2     NO INSTRUCTION START FOUND
SPACF LDB @BINB     FIND FIRST NONSPACE FOR INSTR START 
SPFND LDA B 
SPLP  LDB @BSPS     LOOP UNTIL NONSPACE FOUND 
       JSB .CBT 
      DEF P40       COMPARE 40 SPACES AT A TIME 
      NOP 
      JMP SPLP      NOT FOUND YET TRY NXT 40 SPACES 
      NOP           A CONTAINS BYTE ADDRESS OF FIRST NONSPACE 
      STA STIST     SAVE AS START INSTRUCTION 
      LDB @BINB     SEE IF NONSPACE IN INPUT STRING 
      ADB INLNG     GET BYTE ADDRESS OF END OF STRING 
      CMB,INB 
      ADB A         IF B NEG OK FOUND START INSTRUCTION 
      SSB,RSS 
      JMP EXIT2     NO INSTRUCTION FOUND
      LDA SPC       FIND END INSTRUCTION
      LDB STIST     USE SCAN FOR BYTE 
       JSB .SFB           END MARK IS NULL AT END OF INBUFER
      JMP CKLEN     FOUND SPACE SEE IF IN LEGAL STRING
      JMP EOFLN     TERM FOUND USE END OF INPUT AS END OF INSTR 
CKLEN LDA @BINB 
      ADA INLNG 
      CMA,INA 
      ADA B 
      SSA,RSS 
      JMP EOFLN     USE END OF LINE FOR END INSTRUCTION 
EXIT1 LDA STIST     B CONTAINS END OF INSTR+1 
      CMA,INA 
      ADB A         B NOW CONTAINS LENGTH INSTRUCTION 
      LDA STIST 
      JMP ISTPR,I   NORMAL RETURN FROM INSTRUCTION
* END OF INSTRUCTION = END OF LINE
EOFLN LDB @BINB 
      ADB INLNG 
      JMP EXIT1     B CONTAINS END OF INSTR+1 
*NO INSTRUCTION TO BE HAD 
EXIT2 LDB N1
      JMP ISTPR,I   RETURN WHEN ERROR HAS OCCURED 
*CONSTANTS
ASTRX OCT 25000 
SPACE OCT 20000 
SPC   OCT 40        SPACE WITH NUL FOR TERM CHAR
N1    DEC -1
P40   DEC 40
@BINB DBL INBUF 
@BSPS DBL SPSTR 
SPSTR ASC 20, 
*VARIABLES
STIST NOP           START OF INSTRUCTION BYTE ADDRESS SAVE AREA 
INLNG NOP           LENGTH OF ACTUAL STIRNG 
INBUF BSS 75        UP TO 150 CHAR INPUT STRING 
      NOP           END MARK FOR SCAN FOR BYTE INSTRUCTIONS 
      EXT  .CBT   
      EXT  .SFB   
      END 
ASMB,R,Q,C
* 
*PARM PARSE ROUTINE USED IN CMX2L SYSTEM
* 
*PARMS CAN BE SEPARATED BY COMMAS OR SPACES 
*SPACES FOLLOWING , + - OR ( ARE IGNORED. 
* 
*OP1 STRING TO PARSE WORD ADDRESS 
*OP2 LENGTH OF STRING WORD ADDRESS CHARS
*OP3 ADDR OF NUM CHARS TO SKIP BEFORE PARSING 
*     ON RETURN IS RESET TO SKIP CHARS SCANNED THIS PASS
* 
*A REG ON RETURN START PARM BYTE ADDRESS
*B REG ON RETURN
*     -1 NO PARM FOUND
*     >0 PARM LENGTH IN CHARS 
* 
* NOTE ',     ,' IS A NULL PARM BY THESE RULES
* 
*THIS ROUTINE IS BASED ON A SYNTAX DIAGRAM OF A LEGAL 
*PARM 
* 
*EACH CHARACTER IS EXAMINED ONE AT A TIME TO DECIDE THE 
*CORRECT COURSE OF ACTION 
* 
*THE DECISION STRUCTURE 
* 
*     DECISION 1
*                   COMMA GOTO DECISION 1 
*                   SPACE GO TO DECISION 1
*                   CHAR START PARM GOTO DECISION 2 
*                   ENDSTRING GOTO NULL PARM
*     DECISION 2
*                   SPACE OR ENDSTRING GOTO ENDPARM FOUND 
*                   CHAR GOTO DECISION 2
*                   '+ - (' NOT END YET GOTO DECISION 3 
*                   COMMA SAVE POSSIBLE END OF PARM GOTO DECISION 4 
*                         MAY BE INDIRECT 
*     DECISION 3
*                   SPACE GOTO DECISION 3 
*                   ENDSTRING GOTO ENDPARM
*                   ALL ELSE GOTO DECISION 2 (EFFECTIVELY IGNORES SPACES) 
*     DECISION 4 (CHECK FOR POSSIBLE INDIRECT)
*                   'I' GOTO DECISION  5
*                   SPACE GOTO DECISION 4 (IGNORE SPACES) 
*                   ANY OTHER CHAR GOTO BACKUP-WAS-ENDPARM
*     DECISION 5
*                   ENDSTRING OR SPACE OR COMA
*                     GOTO ENDPARM (WAS INDIRECT!)
*                   NOT STRICTLY TRUE BUT FOR THIS PROGRAM
*                   ANY OTHER CHAR GOTO BACKUP-WAS-ENDPARM
*                   WHEN CALCULATING SKIP CHARS PIKUP PREV CHAR 
* 
      NAM PRMPR 
      ENT PRMPR 
      EXT RESA
A     EQU 0 
B     EQU 1 
PRMPR NOP 
      LDA PRMPR,I   GET ADDRESS OF STRING 
      JSB RESA      WANT DIRECT ADDRESS ONLY! 
      STA @STRG      SAVE IN ADDRESS OF STRING
      ISZ PRMPR     GET LENGTH
      LDA PRMPR,I 
      LDA A,I 
      STA STBLN     SAVE LENGTH STRING IN CHARS 
      ISZ PRMPR     GET NUM CHARS TO SKIP 
      LDA PRMPR,I 
      LDA A,I 
      STA PRSTA     SAVE NUM CHARS TO SKIP
* 
*IF START PARSE BEYOND END OF STRING NO PARSE 
* 
      CMA,INA 
      ADA STBLN 
      STA LP1CT     SAVE NUMBER OF CHARS TO LOOK AT 
      SSA           IF NEG NO PARMS 
      JMP NLPRM 
* 
*FIND START OF POSSIBLE PARM
* 
      LDA @STRG 
      CLE,ELA       CONVERT TO BYTE ADRESS
      ADA PRSTA     ADDRESS TO START PARSE
      STA @PRMS     ASSUME FOR NOW THIS IS START PARM 
*                   @PRMS IS CURRENT SEARCH POINT OF PARM SCAN
* 
*DO DECISION 1 OF PARM PARSE
*USE LOOP STRUCTURE TO DETECT IF END OF STRING FOUND
* 
      LDA LP1CT     COMPLIMENT NUM CHAR TO EXAMINE
      CMA           FOR ISZ INSTRUCTION 
      STA LP1CT 
      LDB @PRMS     SET B REG TO ADDRESS CURRENT CHAR 
* 
*DECISION POINT 1 
* 
LP1   ISZ LP1CT     ENDSTRING?
      JMP *+2       NO
      JMP NLPRM     YES 
       JSB .LBT           EXAMINE CURRENT CHAR
      CPA SPACE     SPACE?
      JMP LP1       YES CONTINUE DECISION 1 
      CPA COMA      COMMA?
      JMP LP1       YES CONTINUE DECISION 1 
* 
*START OF PARM FOUND
* 
      ADB N1        SAVE BYTE ADDRESS OF START OF PARM
      STB @STPR     START PARM ADDRESS
      INB           SET B TO NEXT CHARACTER TO EXAMINE
* 
*DECISION POINT 2 
* 
LP2   ISZ LP1CT     ENDSTRING?
      JMP *+3       NO
      INB           GET LAST CHAR IN PARM 
      JMP ENPRM     YES END PARM FOUND
       JSB .LBT           GET CURRENT CHAR SET B TO NEXT CHAR 
      CPA SPACE     SPACE?
      JMP ENPRM     YES END OF PARM FOUND 
      CPA COMA      COMMA?
      JMP DEC4      YES GOTO DECISION 4 MAYBE INDIRECT
      CPA PLUS      CHECK '+ - (' CHARS 
      JMP DEC3
      CPA MINS      '-' 
      JMP DEC3
      CPA LPREN     '(' 
      JMP DEC3
      JMP LP2       ANY OTHER CHAR CONTINUE PARM
* 
*DECISION POINT 3 (IGNORE SPACES FOLLOWING + - (' 
* 
DEC3  ISZ LP1CT     ENDSTRING?
      JMP *+3 
      INB           GET LAST CHAR IN PARM 
      JMP ENPRM     YES END PARM FOUND
*                   NOTE AT THIS POINT PARM SYNTAX HAS BEEN 
*                   VIOLATED AND ERROR MESSAGE WILL BE GENERATED BY 
*                   ASSEMBLER!
       JSB .LBT           EXAMINE CURRENT CHARACTER 
      CPA SPACE     SPACE?
      JMP DEC3      YES IGNORE IT 
      JMP LP2       ANY OTHER CHAR CONTINUE GETTING PARM
* 
*DECISION POINT 4 
* 
DEC4  STB BKSAV     SAVE POSSIBLE ENDPARM ADDRESS 
*                   IN CASE THIS IS END OF PARM 
LP4   ISZ LP1CT     ENDSTRING?
      JMP *+2       NO
      JMP BKPRM     YES BKSAV WAS END OF PARM 
       JSB .LBT EXAMINE CURRENT BYTE
      CPA SPACE     SPACE?
      JMP LP4       YES IGNORE IT 
      CPA SYMI      'I'?
      JMP DEC5      YES SEE IF INDIRECT 
      JMP BKPRM     ANY OTHER CHAR
*                   BKSAV WAS END OF PARM 
* 
*DECISION POINT 5 
* 
DEC5  ISZ LP1CT     ENDSTRING?
      JMP *+3       NO
      INB           GET I CHAR INTO PARM
      JMP ENPRM     YES CORRECT ENDPARM (WAS INDIRECT)
       JSB .LBT           EXAMINE CURRENT CHAR
      CPA SPACE     SPACE?
      JMP ENPRM     YES CORRECT ENDPARM (WAS INDIRECT)
      CPA COMA      COMA? 
      JMP ENPRM     YES WILL TAKE AS INDIRECT BUT IS ERROR REALLY 
* 
*FALL INTO ENDPARM WAS BKSAV
* 
*NOTE WANT TO SCAN CURRENT CHAR ON NEXT PASS
* 
BKPRM LDA @STRG     START WITH WORD ADDRESS OF STRING 
      CLE,ELA 
      CMA 
      ADA BKSAV     NUMBER OF CHARS TO SKIP 
      LDB PRMPR,I   ADDRESS OF NUM CHARS TO SKIP PARM 
      STA B,I       UPDATE NUM CHARS SKIP FOR NEXT PASS 
      ISZ PRMPR     SET TO RETURN ADDRESS 
* 
*CALC PARM LENGTH 
* 
      LDB @STPR     BKSAV-@START PARM-1=PARM LENGTH 
      CMB 
      ADB BKSAV 
      LDA @STPR     RETURN BYTE ADDRESS START PARM
      JMP PRMPR,I   RETURN TO CALLING ROUTINE 
* 
*END PARM NORMAL
* 
ENPRM STB @PRMS 
* 
*CALC NUMBER OF CHARS TO SKIP ON NEXT PASS
* 
      LDA @STRG 
      CLE,ELA       CONVERT WORD TO BYTE
      CMA           SCAN CURRENT CHAR ON NEXT PASS
      ADA B 
      LDB PRMPR,I   ADDRESS OF SKIP CHARS PARM
      STA B,I       UPDATE SKIP CHARS PARM
      ISZ PRMPR     SET TO RETURN ADDRESS 
* 
*CALC LENGTH OF PARM
* 
      LDB @STPR 
      CMB           DON'T WANT CHAR THAT STOPS PARM 
      ADB @PRMS     B CONTAINS PARM LENGTH
*                   DUE TO PROGRAM STRUCTURE ALWAYS>0 
      LDA @STPR     RETURN BYTE ADDRESS OF START OF PARM
      JMP PRMPR,I   RETURN
* 
*NULL PARM OR NO STRING LEFT
* 
NLPRM LDA @STRG 
      CLE,ELA       WORD TO BYTE ADDRESS
      CMA,INA 
      ADA @PRMS     CALC NUMBER OF CHARS TO SKIP
      LDB PRMPR,I   ADDRESS OF SKIP CHARS PARM
      STA B,I       SAVE NUM CHARS TO SKIP FOR NEXT PASS
      ISZ PRMPR     SET TO RETURN ADDRESS 
      LDB N1        SET NULL PARM RETURN FLAG 
      JMP PRMPR,I   RETURN
* 
*DATA 
* 
N1    DEC -1
COMA  OCT 54        COMMA CHARACTER 
LPREN OCT 50        LEFT PARENTHESIS
MINS  OCT 55        MINUS SIGN
PLUS  OCT 53        PLUS SIGN 
SPACE OCT 40        SPACE CHARACTER 
SYMI  OCT 111       CAPITAL I CHARACTER 
* 
*VARIABLES
* 
@PRMS NOP           CURRENT CHAR OF PARMS SCAN
@STPR NOP           START OF PARM BYTE ADDRESS
@STRG NOP           WORD ADDRESS OF STRING BEING SCANNED
BKSAV NOP           SAVE FOR ADDRESS OF POSSIBLE END OF PARM
LP1CT NOP           -NUMBER OF CHARS LEFT TO SCAN-1 
PRSTA NOP           NUMBER OF CHARS TO SKIP BEFORE SCAN 
STBLN NOP           LENGTH OF STRING IN CHARS INCLUDES SKIPED CHARS 
      EXT  .LBT   
      END 
ASMB,R,Q,C
      NAM SERCH 
* 
*SERCH
*     A REG CONTAINS BYTE ADDRESS OF INSTR TO FIND IN TABLE 
*     OP1 IS ADDRESS OF LENGTH OF THE INSTR TO USE
* 
* THIS ROUTINE USES A BINARY SEARCH 
* AND BYTE COMPARE TO FIND THE INSTR IN THE TABLE 
* 
* INSTR FOUND 
*     A REG CONTAINS 0
*     B REG CONTAINS WORD ADDRESS IN TABLE OF START OF MATCHING ENTRY 
* 
* INSTR NOT FOUND 
*     A REG CONTAINS -1 
*     B IS RANDOM 
* 
* TABLE ENTRY 
* 3 WORDS INSTR LEFT JUSTIFIED
* 1 BYTE NUMBER OF DUMMY ENTRIES FOR INSTR
* 1 BYTE NUMBER OF PARMS FOR INSTR (ADDRESS'S)
* 1 WORD INSTR USED MARK LOCATION INIT 0
* 
      EXT TABLE,STMIN,STMAX 
      ENT SERCH 
A     EQU 0 
B     EQU 1 
SERCH NOP 
      STA INSTR     SAVE BYTE ADDRESS OF INSTR
      LDA SERCH,I   GET ADDRESS OF LENGTH PARM
      LDA A,I       GET LENGTH
      STA INLEN     SAVE LENGTH IN INLEN
      ISZ SERCH     STEP TO RETURN ADDRESS
      LDA STMAX 
      STA MAX       SET INITIAL ENTRY NUMBERS OF LIST TO SEARCH 
      LDA STMIN 
      STA MIN 
* 
*NORMALIZE INPUT TO TABLE LENGTH OF 3 WORDS PER ENTRY 
* 
*IF IN LENGTH > 6 CHARS NOT FOUND 
* 
      LDA N7
      ADA INLEN 
      SSA,RSS       IF NEG THEN LENGTH < 6 CONTINUE 
      JMP NOTFD     ELSE ENTRY NOT FOUND
      LDA @BLK      BLANK COMPARE AREA
      LDB @IST
       JSB .MVW 
      DEF P3
      NOP 
      LDA INSTR     MOVE INSTRUCTION INTO COMPARE AREA
      LDB @BIST     USE BYTE ADDRESSING TO GET RIGHT NUM CHARS
       JSB .MBT 
      DEF INLEN 
      NOP 
* 
*LOOP TO SEARCH TABLE FOR INSTR 
* 
LP1   LDB MIN       FOR EACH LOOP DISPLACEMENT IN 
      CMB,INB       TABLE FOR COMPARE LOCATION =
      ADB MAX       (MAX-MIN)/2 
      CLE,ERB       TRUNCATE FRACTION 
      SZB,RSS       IF ZERO DISPLACEMENT NOT IN LIST
      JMP NOTFD 
      ADB MIN       B NOW CONTAINS ENTRY NUMBER 
*NOTE THERE IS NO 0'TH ENTRY
*NOTE THERE IS NO N'TH ENTRY WHERE N=STMAX
      STB DISP      STORE ENTRY NUMBER
      BLS           MULTIPLY ENTRY TIMES 5  TO GET
      CLE,ELB       DISPLACEMENT IN WORDS 
      ADB DISP      THIS METHOD SHOULD BE FAST ON L 
      ADB TABAD     B NOW HAS TABLE ENTRY WORD ADDRESS
      LDA @IST      WORD ADDRESS OF INSTR TO FIND 
       JSB .CMW 
      DEF P3        COMPARE WORDS SHOULD BE FASTER
      NOP 
*                   THAN COMPARE BYTES
      JMP FOUND     EQUALS EXIT 
      JMP LESS      INSTR LESS THAN TABLE ENTRY 
MORE  LDB DISP      RESET BOUNDS OF TABLE AND RETRY 
      STB MIN 
      JMP LP1 
LESS  LDB DISP
      STB MAX 
      JMP LP1 
* 
*PROCESS RESULT OF SEARCH 
* 
FOUND ADB N3        B NOW CONTAINS WORD ADDRESS OF START OF MATCH ENTRY 
      LDA P0        SET FOUND FLAG
      JMP SERCH,I   RETURN
NOTFD LDA N1        SET NOT FOUND FLAG
      JMP SERCH,I   RETURN
* 
*DATA AREA
* 
INLEN BSS 1         LENGTH OF INSTR SHOULD BE <6
INSTR BSS 1         BYTE ADDRESS OF INSTR TO LOOK FOR 
MIN   BSS 1         CURRENT MIN ENTRY BOUNDARY NUMBER 
MAX   BSS 1         CURRENT MAX ENTRY BOUNDARY NUMBER 
DISP  BSS 1         DISPLACEMENT IN TABLE IN ENTRY NUMBERS
P0    DEC 0 
N1    DEC -1
N7    DEC -7
N3    DEC -3
P3    DEC 3 
TABAD DEF TABLE-5   WANT ABSOLUTE ADDRESS HERE DISPLACED FOR NO 0 ENTRY 
@BLK  DEF BLK 
BLK   ASC 3,
@IST  DEF IST 
@BIST DBL IST 
IST   BSS 3         BUFFER LOCATION FOR INSTRUCTION TO FIND 
      EXT  .CMW   
      EXT  .MBT   
      EXT  .MVW   
      END 
ASMB,R,Q,C
* 
*INSTRUCTION TABLE
* 
*ENTRY
*     3 WORDS       INSTR LEFT JUSTIFIED
*     1 BYTE        NUM OF DUMMY ENTRIES FOR INSTR
*     1 BYTE        NUM OF PARMS FOR INSTR (ADDRESS'S)
*     1 BYTE        CODE FOR INSTRUCTION TYPE 
*                   0 EXTENDED INSTRUCTION
*                   1 FLOATING POINT INSTRUCTION
*                   2 SCIENTIFIC INSTRUCTION
*                   3 FAST FORTRAN
*                   4 DMS INSTRUCTION 
*                   5-255 UNUSED CODES
*     1 BYTE        MARK WORD FOR INSTRUCTION USED
* 
      NAM TABLE 
      ENT STMIN,STMAX,TABAD 
      ENT TABLE 
STMIN DEC 0         MINUMUM ENTRY NUMBER -1 
*                   ENTRIES RUN FROM 1 TO N 
STMAX DEC 122       NUM OF ENTRIES (N) +1 
*                   ACCOUNTS FOR NONEXISTANT O'TH AND N'TH ENTRIES
TABAD DBL TABLE-5   ACCOUNT FOR ENTRY 1 AT ADDRESS 0
      NOP           FIX FOR ASSEMBLER SICE WON'T ALLOW NEG DISPLACEMENTS
      NOP 
      NOP 
      SUP PRESS PRINTING
      SKP           BEGIN TABLE ON CLEAR PAGE 
TABLE ASC 3,.DCM    FF
      OCT 1 
      OCT 1400
      ASC 3,.MAP    FAST FORT FF
      OCT 0 
      OCT 1400
      ASC 3,ADX     INSTR LEFT JUSTIFIED IN 6 CHAR FIELD
      DEC 1         1 OPERAND 
      NOP           INSTR USED MARK 
      ASC 3,ADY 
      NOP 
      NOP 
      ASC 3,ALOG    SCIENTIFIC
      NOP 
      OCT 1000
      ASC 3,ALOGT   SCIENTIFIC
      NOP 
      OCT 1000
      ASC 3,ATAN    SCIENTIFIC
      NOP 
      OCT 1000
      ASC 3,CAX 
      NOP 
      NOP 
      ASC 3,CAY 
      NOP 
      NOP 
      ASC 3,CBS 
      DEC 2 
      NOP 
      ASC 3,CBT 
      OCT 401       1 DUMMY 1 PARM
      NOP 
      ASC 3,CBX 
      NOP 
      NOP 
      ASC 3,CBY 
      NOP 
      NOP 
      ASC 3,CMW 
      OCT 401       1 DUMMY 1 PARM
      NOP 
      ASC 3,COS     SCIENTIFIC
      OCT 0 
      OCT 1000
      ASC 3,CXA 
      NOP 
      NOP 
      ASC 3,CXB 
      NOP 
      NOP 
      ASC 3,CYA 
      NOP 
      NOP 
      ASC 3,CYB 
      NOP 
      NOP 
      ASC 3,DBLE    FF
      OCT 3 
      OCT 1400
      ASC 3,DDINT   FF
      OCT 3 
      OCT 1400
      ASC 3,DFER    FF
      OCT 2 
      OCT 1400
      ASC 3,DJP     DMS INSTRUCTION 
      OCT 1 
      OCT 2000
      ASC 3,DJS     DMS INSTRUCTION 
      OCT 1 
      OCT 2000
      ASC 3,DSX 
      NOP 
      NOP 
      ASC 3,DSY 
      NOP 
      NOP 
      ASC 3,ENTP    FF
      OCT 0 
      OCT 1400
      ASC 3,ENTR    FF
      OCT 0 
      OCT 1400
      ASC 3,EXP     SCIENTIFIC
      NOP 
      OCT 1000
      ASC 3,FAD     FLOATING POINT INSTRUCTION
      OCT 1         1 OPERAND 
      OCT 400       FLOAT INSTRUCTION TYPE
      ASC 3,FDV 
      OCT 1 
      OCT 400 
      ASC 3,FIX 
      OCT 0 
      OCT 400 
      ASC 3,FIXD    FP
      NOP 
      OCT 400 
      ASC 3,FLT 
      OCT 0 
      OCT 400 
      ASC 3,FLTD    FP
      NOP 
      OCT 400 
      ASC 3,FLUN    FF
      OCT 0 
      OCT 1400
      ASC 3,FMP 
      OCT 1 
      OCT 400 
      ASC 3,FSB 
      OCT 1 
      OCT 400 
      ASC 3,GOTO    FF
      OCT 0 
      OCT 1400
      ASC 3,ISX 
      NOP 
      NOP 
      ASC 3,ISY 
      NOP 
      NOP 
      ASC 3,JLY 
      DEC 1 
      NOP 
      ASC 3,JPY 
      DEC 1 
      NOP 
      ASC 3,JRS     DMS INSTRUCTION 
      OCT 2 
      OCT 2000
      ASC 3,LAX 
      DEC 1 
      NOP 
      ASC 3,LAY 
      DEC 1 
      NOP 
      ASC 3,LBT 
      NOP 
      NOP 
      ASC 3,LBX 
      DEC 1 
      NOP 
      ASC 3,LBY 
      DEC 1 
      NOP 
      ASC 3,LDX 
      DEC 1 
      NOP 
      ASC 3,LDY 
      DEC 1 
      NOP 
      ASC 3,LFA     DMS 
      NOP 
      OCT 2000
      ASC 3,LFB     DMS 
      NOP 
      OCT 2000
      ASC 3,MBF     DMS 
      NOP 
      OCT 2000
      ASC 3,MBI     DMS 
      NOP 
      OCT 2000
      ASC 3,MBT 
      OCT 401       1 DUMMY 1 PARM
      NOP 
      ASC 3,MBW     DMS 
      NOP 
      OCT 2000
      ASC 3,MVW 
      OCT 401       1 DUMMY 1 PARM
      NOP 
      ASC 3,MWF     DMS 
      NOP 
      OCT 2000
      ASC 3,MWI     DMS 
      NOP 
      OCT 2000
      ASC 3,MWW     DMS 
      NOP 
      OCT 2000
      ASC 3,PAA     DMS 
      NOP 
      OCT 2000
      ASC 3,PAB     DMS 
      NOP 
      OCT 2000
      ASC 3,PACK    FF
      OCT 0 
      OCT 1400
      ASC 3,PBA     DMS 
      NOP 
      OCT 2000
      ASC 3,PBB     DMS 
      NOP 
      OCT 2000
      ASC 3,PWR2    FF
      OCT 0 
      OCT 1400
      ASC 3,RSA     DMS 
      NOP 
      OCT 2000
      ASC 3,RSB     DMS 
      NOP 
      OCT 2000
      ASC 3,RVA     DMS 
      NOP 
      OCT 2000
      ASC 3,RVB     DMS 
      NOP 
      OCT 2000
      ASC 3,SAX 
      DEC 1 
      NOP 
      ASC 3,SAY 
      DEC 1 
      NOP 
      ASC 3,SBS 
      DEC 2 
      NOP 
      ASC 3,SBT 
      NOP 
      NOP 
      ASC 3,SBX 
      DEC 1 
      NOP 
      ASC 3,SBY 
      DEC 1 
      NOP 
      ASC 3,SETP    FF
      OCT 0 
      OCT 1400
      ASC 3,SFB 
      NOP 
      NOP 
      ASC 3,SIN     SCIENTIFIC
      NOP 
      OCT 1000
      ASC 3,SJP     DMS 
      OCT 1 
      OCT 2000
      ASC 3,SJS     DMS 
      OCT 1 
      OCT 2000
      ASC 3,SNGL    FF
      OCT 2 
      OCT 1400
      ASC 3,SQRT    SCIENTIFIC
      NOP 
      OCT 1000
      ASC 3,SSM     DMS 
      OCT 1 
      OCT 2000
      ASC 3,STX 
      DEC 1 
      NOP 
      ASC 3,STY 
      DEC 1 
      NOP 
      ASC 3,SYA     DMS 
      NOP 
      OCT 2000
      ASC 3,SYB     DMS 
      NOP 
      OCT 2000
      ASC 3,TADD    FP
      OCT 3 
      OCT 400 
      ASC 3,TAN     SCIENTIFIC
      NOP 
      OCT 1000
      ASC 3,TANH    SCIENTIFIC
      NOP 
      OCT 1000
      ASC 3,TBS 
      DEC 2 
      NOP 
      ASC 3,TDIV    FP
      OCT 3 
      OCT 400 
      ASC 3,TFTD    FP
      OCT 1 
      OCT 400 
      ASC 3,TFTS    FP
      OCT 1 
      OCT 400 
      ASC 3,TFXD    FP
      OCT 1 
      OCT 400 
      ASC 3,TFXS    FP
      OCT 1 
      OCT 400 
      ASC 3,TMPY    FP
      OCT 3 
      OCT 400 
      ASC 3,TSUB    FP
      OCT 3 
      OCT 400 
      ASC 3,UJP     DMS 
      OCT 1 
      OCT 2000
      ASC 3,UJS     DMS 
      OCT 1 
      OCT 2000
      ASC 3,USA     DMS 
      NOP 
      OCT 2000
      ASC 3,USB     DMS 
      NOP 
      OCT 2000
      ASC 3,XAX 
      NOP 
      NOP 
      ASC 3,XAY 
      NOP 
      NOP 
      ASC 3,XBX 
      NOP 
      NOP 
      ASC 3,XBY 
      NOP 
      NOP 
      ASC 3,XCA     DMS 
      OCT 1 
      OCT 2000
      ASC 3,XCB     DMS 
      OCT 1 
      OCT 2000
      ASC 3,XCOM    FF
      OCT 1 
      OCT 1400
      ASC 3,XFER    FF
      OCT 0 
      OCT 1400
      ASC 3,XLA     DMS 
      OCT 1 
      OCT 2000
      ASC 3,XLB     DMS 
      OCT 1 
      OCT 2000
      ASC 3,XMA     DMS 
      OCT 0 
      OCT 2000
      ASC 3,XMB     DMS 
      NOP 
      OCT 2000
      ASC 3,XMM     DMS 
      NOP 
      OCT 2000
      ASC 3,XMS     DMS 
      NOP 
      OCT 2000
      ASC 3,XPAK    FF
      OCT 1 
      OCT 1400
      ASC 3,XSA     DMS 
      OCT 1 
      OCT 2000
      ASC 3,XSB     DMS 
      OCT 1 
      OCT 2000
      END 
ASMB,R,L,T,C
* 
*ADEXT PROG 
*     THIS PROGRAM IS PART OF CMX2L 
*     IT READS THE INSTR TABLE AND CHECKS FOR 
*     INSTRUCTION USED MARKS
*     FOR EACH MARK FOUND THE PROGRAM 
*     PRINTS OUT
*     EXT  .INSTR 
* 
      NAM ADEXT 
      EXT OUTMG,STMAX,TABLE 
      EXT RESB
      ENT ADEXT 
A     EQU 0 
B     EQU 1 
ADEXT NOP 
      LDA STMAX     GET NUMBER OF ENTRIES IN TABLE
      CMA,INA 
      STA LPCNT     INITIALIZE LOOP COUNTER 
      LDB @TABL     B POINTS AT START OF INSTR ENTRY
      JSB RESB      NEED DIRECT ADDRESS FOR INDEXING! 
* 
*DO LPCNT =-(NUM INSTRUCTIONS+1) TO -1 BY 1 
* 
LOOP1 ISZ LPCNT 
      JMP *+2 
      JMP ADEXT,I   WHEN DONE WITH TABLE RETURN 
      ADB P4        STEP TO INSTR USED WORD 
      LDA B,I       GET MARK AND INSTR TYPE 
      AND P3        CHECK ONLY INSTRUCTION USED MARK AND EXT MARK 
      SZA 
      JSB PEXT      INSTRUCTION USED PRINT EXT
      INB           STEP TO NEXT TABLE ENTRY
      JMP LOOP1 
* 
*PRINT EXT STATEMENT
* 
PEXT  NOP 
      CPA P1        IF NOT ALREADY EXT THEN DO EXT
      JMP *+2       NO EXT FOUND ADD ONE
      JMP PEXT,I    MARK SET RETURN 
      STB TEMP
      ADB N4        GET INSTRUCTION MENOMIC 
      LDA B 
      LDB @MS       MOVE MENOMIC INTO EXT MESSAGE 
       JSB .MVW 
      DEF P3
      NOP 
      LDA @MSNM 
      JSB OUTMG     PRINT MESSAGE TO OUTPUT FILE
      LDB TEMP
      JMP PEXT,I    DO NEXT ENTRY 
* 
*DATA 
* 
N4    DEC -4
P1    DEC 1 
P2    DEC 2 
P3    DEC 3 
P4    DEC 4 
LPCNT NOP           LOOP COUNTER
TEMP  NOP           TEMPORARY STORAGE FOR B REGISTER
@TABL DEF TABLE     WORD ADDRESS OF FIRST ENTRY IN INSTR TABLE
@MS   DEF MSNM+7   POINT FOR SUBSTITUTION OF INSTR MENOMIC
@MSNM DEF MSNM
MSNM  DEC 9 
      ASC 9,      EXT  .
      EXT  .MVW   
      END 
ASMB,R,Q,C
* THIS SUBROUTINE IS A GENERAL OUTPUT ROUTINE USED FOR ASSEMBLING 
* OUTPUT RECORDS. 
* PRINTS TO LIST FILE AND OUT FILE
* LIST LDCB3
* OUT  ODCB2
* OUTPT 
*     OPERAND 1  ADDRESS OF OPTION CODE 
*                   0 PRINT OLD LINE
*                   1 PRINT OLD LINE START NEW LINE 
*                   2 APPEND NEW LINE TO OLD LINE 
*                   3 START NEW LINE
*                   4 PRINT OLD LINE LIST ONLY
*                   5 PRINT OLD START NEW PRINT ON LIST ONLY
*                   6 ALIAS TO OPTION 2 
*                   7 ALIAS TO OPTION 3 
*     OPERAND 2  ADDRESS OF NUMBER OF INPUT CHARACTERS
*     A REG IS SET TO BYTE ADDRESS OF STRING TO OUTPUT
* 
*     NOTE: MAX LENGTH OF OLDLINE AT ANY GIVEN TIME 75  WORDS 150 CHARS 
*     NOTE: ODCB2 DATA CONTROL BLOCK EXTERNAL RECOMENDED LENGTH 144 WORDS 
*     NOTE: FLERR EXTERNAL ROUTINE TO GENERATE APPROPRIATE ERROR MESSAGE
*           FMP ERROR CODE RETURNED IN A REGISTER 
* 
      NAM OUTPT 
      ENT OUTPT 
      EXT WRITF,ODCB2,FLERR,FILE2,IERR2 
      EXT LDCB3,FILE3,IERR3 
A     EQU 0 
B     EQU 1 
      SUP PRESS PRINTING
OUTPT NOP 
      STA @BIN      SAVE A REGISTER ADDRESS PARM
      LDA OUTPT,I   GET OPTION ADDRESS
      ISZ OUTPT     SET TO LENGTH PARM
      LDA A,I       GET OPTION CODE 
      STA OPTN      SAVE OPTION FOR OUTPUT VERSUS LIST TEST 
      AND =B3       SELECT ONLY VALID OPTION BITS 
      ADA @JPTB     USE ADDRESS JUMP TABLE TO DECODE OPTION 
      LDA A,I       GET ADDRESS OF ROUTINE TO EXECUTE 
      JMP A,I 
@JPTB DEF *+1 
      DEF PNTO      PRINT OLD 
      DEF POSN      PRINT OLD START NEW 
      DEF ANOL      APPEND NEW TO OLD 
      DEF STNL      START NEW LINE
* ALL OPTIONS REFER TO CONSTRUCTION OF OUTPUT 
* BUFFER FOR OUTPUT TO FILE OR LU DEVICE
PNTO  JSB WRIT      PRINT OLD LINE
      ISZ OUTPT     SET TO RETURN ADDRESS 
      JMP OUTPT,I   RETURN
POSN JSB WRIT       PRINT OLD START NEW 
STNL  JSB CLRLN     CLEAR OLD OUTBUF
ANOL  JSB STNW      APPEND NEW LINE 
      ISZ OUTPT     SET TO RETURN ADDRESS 
      JMP OUTPT,I   RETURN
* 
*WRIT ROUTINE WRITES OUTBUFFER TO FILE
* 
WRIT  NOP 
      LDA OIL       GET OUTBUF LENGTH IN CHARS
      SZA,RSS       IF ZERO LENGTH TO OUT 
      JMP WRIT,I    THEN RETURN 
      SLA,ARS       CONVERT TO WORDS
      INA           IF WAS ODD PRINT EXTRA WORD 
      STA WRDLN     SAVE IN WORDLENGTH
      JSB WRITF     WRITE THE BUFFER
      DEF *+5 
      DEF LDCB3     LIST DATA CONTROL BLOCK 
      DEF IERR3     LIST ERROR FLAG 
      DEF OUTBF     OUTBUFFER 
      DEF WRDLN     OUT BUFFER LENGTH IN WORDS
      SSA,RSS       SEE IF ERROR ON OUTPUT FILE 
      JMP WROT      SEE IF WRITE TO OUTPUT
      JSB FLERR     ERROR RETURN
      DEF FILE3     PARM FOR FLERR
* 
*WRITE TO OUT FILE IF NECESSARY 
* 
WROT  LDA OPTN      GET OPTION
      AND M4        CHECK BIT 2 
      SZA           IF BIT 3 SET DONOT WRITE TO OUTPUT
      JMP WRIT,I    RETURN NO OUTPUT WRITE
* 
*WRITE TO OUTPUT FILE 
* 
      JSB WRITF 
      DEF *+5 
      DEF ODCB2     OUTPUT DATA CONTROL BLOCK 
      DEF IERR3     ERROR PARM FOR OUTPUT FILE
      DEF OUTBF     OUTPUT BUFFER 
      DEF WRDLN     BUFFER LENGTH IN WORDS
      SSA,RSS       SEE IF ERROR
      JMP WRIT,I    NORMAL RETURN WRITE LIST AND OUTPUT 
      JSB FLERR     ERROR EXIT FROM PROGRAM 
      DEF FILE2     FILE NAME PARM
* 
*CLRLN CLEARS OUTBUF POINTERS TO ALLOW NEW LINE 
* 
CLRLN NOP 
      LDA P0
      STA OIL 
      JMP CLRLN,I   RETURN
* 
*STNW APPENDS INPUT TO OUTPUT BUFFER
* 
STNW  NOP 
      LDA OUTPT,I   GET NUM CHARS TO TRANSFER 
      LDA A,I 
      STA NMCHR 
* 
*CHECK FOR OUTPUT BUFFER TOO LONG 150 CHARS MAX 
* 
      ADA OIL 
      CMA,INA 
      ADA P150
      SSA,RSS       IF NEG TOO LONG 
      JMP OKLG      OK DO IT
      LDA OIL       TRUNCATE TO 150 CHARS 
      CMA,INA 
      ADA P150
      SZA,RSS 
      JMP STNW,I    RETURN IF ZERO CHARS TO MOVE
      STA NMCHR     ELSE UPDATE NUM CHARS TO MOVE 
OKLG  LDA @BIN      GET SOURCE ADDRESS
      LDB @BOUT     GET DEST ADDRESS
      ADB OIL 
       JSB .MBT 
      DEF NMCHR     MOVE TO OUTBUF
      NOP 
      LDA @BSPC     APPEND TRAILING SPACE 
*                   EXTRA SPACE ALLOWS WORDS OUTPUT WITHOUT 
*                   SPECIAL HANDLING
       JSB .MBT 
      DEF P1
      NOP 
      LDB OIL       FIX OUTPUT LINE CHAR LENGTH 
      ADB NMCHR 
      STB OIL 
      JMP STNW,I    RETURN
* 
*DATA 
* 
P0    DEC 0 
P1    DEC 1 
M4    OCT 4 
P150  DEC 150 
OPTN  NOP           INPUT CONTROL OPTION
@BIN  NOP           BYTE ADDRESS OF INPUT 
@BOUT DBL OUTBF     BYTE ADDRESS OF OUTPUT BUFFER 
@BSPC DBR SPC       ADDRESS OF SPACE TO APPEND TO ENDLINE 
SPC   OCT 40
NMCHR NOP           NUMBER OF CHARACTERS IN INPUT BUFFER
OIL   DEC 0         OUTPUT LINE LENGTH IN CHARS 
WRDLN NOP           OUTPUT LINE LENGTH IN WORDS 
OUTBF ASC 25, 
      ASC 26, 
      EXT  .MBT   
      END 
ASMB,R,L,T,C
      NAM OUTMG 
      ENT OUTMG 
      EXT OUTPT 
A     EQU 0 
B     EQU 1 
*OUTMG PRINTS STANDARD MESSAGES ON OUTPUT FILE USING
*     PROGRAM OUTPT PART OF CMX2L SYSTEM
* 
* RECEIVES WORD ADDRESS OF MESSAGE RECORD IN A REG
* MESSAGE RECORD FIRST WORD IS NUMBER OF WORDS IN MESSAGE 
* A ADDRESS MAY BE INDIRECT 
* 
OUTMG NOP 
* 
*RESOLVE ADDRESS TO ALLOW INDEXING TO MESSAGE 
* 
RESLP SSA,RSS 
      JMP RESL      DONE HAVE FINAL ADDRESS 
      AND =B077777  CLEAR INDIRECT BIT
      LDA A,I       GET NEXT ADDRESS IN CHAIN 
      JMP RESLP 
RESL  LDB A,I       GET NUMBER WORDS IN MESSAGE 
      CLE,ELB       CONVERT WORDS TO CHARACTERS 
      STB CHRNM     SAVE NUMBER CHARS IN MESSAGE
      INA           STEP TO ADDRESS OF MESSAGE
      CLE,ELA       CONVERT TO BYTE ADDRESS 
      JSB OUTPT 
      DEF P3        NEW LINE
      DEF CHRNM     LENGTH
      LDA P0
      JSB OUTPT 
      DEF P0        PRINT LIE 
      DEF P0
      JMP OUTMG,I   RETURN
* 
*DATA 
* 
P0    DEC 0 
P3    DEC 3 
CHRNM NOP           NUM CHARS IN MESSAGE
      END 
ASMB R,Q
      NAM REPLA 
      ENT .CBS,.CBT,.CMW,.LBT,.MBT,.MVW,.SFB,.TBS 
.CBS  RPL  105774B      
.CBT  RPL  105766B
.CMW  RPL  105776B
.LBT  RPL  105763B
.MBT  RPL  105765B
.MVW  RPL  105777B
.SFB  RPL  105767B
.TBS  RPL  105775B
      END 
  
ASMB,R,Q,C
* 
*PROGRAM OUTPUTS A MESSAGE TO LIST DEVICE OR FILE AND 
* TO TERMINAL NO OUTPUT TO OUTPUT FILE
* 
* REG A WORD ADDRESS OF START OF MESSAGE BUF
*    MESSAGE BUFFER 
*      WORD 1 NUMBER OF WORDS IN MESSAGE
*      WORD 2-N MESSAGE 
* LIST DCB IS LDCB3 
* TERM IS OPRLU 
* OUTPT IS OUTPUT BUFFERING ROUTINE OF CMX2L
* 
      NAM OUTML 
      ENT OUTML 
      EXT RESA,OUTPT,REIO,OPRLU 
A     EQU 0 
B     EQU 2 
OUTML NOP 
      JSB RESA      RESOLVE POSSIBLE INDIRECT ADDRESS 
      LDB A,I       GET NUMBER WORDS IN MESSAGE 
      STB NMWRD     SAVE NUMBER WORDS 
      CLE,ELB       CONVERT TO CHARS IN MESSAGE 
      STB CHRNM     SAVE NUMBER OF CHARS IN MESSAGE 
      INA STEP TO FIRST WORD OF MESSAGE 
      STA @DMSG     SAVE WORD ADDRESS OF START OF MESSAGE 
      CLE,ELA       CONVERT TO BYTE ADDRESS FOR OUTPT 
      JSB OUTPT     PRINT MESSAGE ON LIST DEVICE
      DEF P3        NEW LINE
      DEF CHRNM     NUMBER OF CHARS 
      LDA P0        FORCE PRINTING OF BUFFER
      JSB OUTPT 
      DEF P4        PRINT ON LIST FILE ONLY 
      DEF P0
      JSB REIO      PRINT TO TERMINAL 
      DEF *+5 
      DEF P2        PRINT 
      DEF OPRLU     TERMINAL LU 
      DEF @DMSG,I   MESSAGE 
      DEF NMWRD     NUMBER OF WORDS 
      JMP OUTML,I   RETURN
* 
*DATA 
* 
P0    DEC 0 
P2    DEC 2 
P3    DEC 3 
P4    DEC 4 
NMWRD NOP           NUMBER OF WORDS IN MESSAGE
CHRNM NOP           NUMBER OF CHARS IN MESSAGE
@DMSG NOP           WORD ADDRESS OF FIRST WORD OF MESSAGE 
      END 
                                                                                                                