ASMB,R
      HED SUBROUTINES FOR BRANCH AND MNEMONIC TABLE GENERATOR 
      NAM RTMSR,7  92065-16006  REV.1709  770309  
* 
* 
******************************************************* 
* 
* 
*       RTM TABLE GENERATOR SUBROUTINES 
*       MIKE SCHOENDORF 
*       OCTOBER 22, 1976
* 
*       SOURCE:        92065-18012
*       RELOCATEABLE:  92065-16006
* 
* 
******************************************************* 
* 
* 
*  ENTRY POINT NAMES
* 
* 
      ENT ENDRC,ENTBR,ENTBT,ENTMN,ENTMT 
      ENT ERR1A,ERR2,ERR3,ERR4,ERR5,ERR6
      ENT ERR7,ERR8,ERR9,ERR10,ERR11,ERR12
      ENT ERR13,MESS0,MESS1,MESS2,MESS3 
      ENT MESS4,MESS5,MESS6,MESS7,MESS8 
      ENT MESS9,MES10,MESSA,NAMRC,PARS1,PARS2 
      ENT READ1,READ2,READ3,RWIND 
* 
* 
*  EXTERNAL REFERENCE NAMES 
* 
* 
      EXT CNUMD,.ENTR,EXEC,IMESS
      EXT LOCF,PARSE
      SUP 
      SKP 
* 
* 
*  PROMPTS/ERROR MESSAGES 
* 
*    CALLING SEQUENCE:
* 
*        LDA LNGTH          MESSAGE LENGTH
*        LDB ADDRS          MESSAGE ADDRESS 
*        JSB MESSI          OUTPUT TO SESSION CONSOLE 
*        OCT 2
*        RETURN 
* 
* 
* 
*  "RTMTG FINISHED" 
* 
* 
MESS0 NOP 
      JSB .ENTR 
      DEF MESS0 
      LDA D16 
      LDB MES00 
      JSB MESSI 
      OCT 2 
      JMP MESS0,I 
* 
MES00 DEF *+1 
      ASC 8,"RTMTG FINISHED"
* 
*  "RTMTG"
* 
MESS1 NOP 
      JSB .ENTR 
      DEF MESS1 
      LDA B7
      LDB MES01 
      JSB MESSI 
      OCT 2 
      JMP MESS1,I 
* 
B7    OCT 7 
* 
MES01 DEF *+1 
      ASC 4,"RTMTG" 
      SKP 
* 
*  >
* 
MESS2 NOP 
      JSB .ENTR 
      DEF MESS2 
      CLA,INA 
      LDB MES02 
      JSB MESSI 
      OCT 2 
      JMP MESS2,I 
* 
MES02 DEF *+1 
      ASC 1,> 
* 
*  "BRANCH AND MNEMONIC SOURCE EDIT"
* 
MESS3 NOP 
      JSB .ENTR 
      DEF MESS3 
      LDA D33 
      LDB MES03 
      JSB MESSI 
      OCT 2 
      JMP MESS3,I 
* 
D33   DEC 33
* 
MES03 DEF *+1 
      ASC 17,"BRANCH AND MNEMONIC SOURCE EDIT"
* 
*  PENDING LINE NUMBER (N)
* 
N1    NOP 
MESS4 NOP 
      JSB .ENTR 
      DEF N1
      LDA N1,I       GET CURRENT LINE NUMBER
      STA NUMB1 
      JSB CNUMD     CONVERT TO ASCII
      DEF *+3 
      DEF NUMB1     AND PUT IN OUTPUT BUFFER
      DEF BUFA1 
      LDB BUFAD 
      ADB B3
      LDA BLANK 
      STA 1,I 
      INB 
      LDA BKARO     ADD BACK ARROW TO SUPPRESS
      STA 1,I       CARRIAGE RETURN-LINE FEED 
      LDA D10 
      LDB BUFAD 
      JSB MESSI 
      OCT 2 
      JMP MESS4,I 
* 
B4    OCT 4 
* 
NUMB1 NOP 
* 
BKARO OCT 20137 
      SKP 
* 
*  "LIST" 
* 
MESS5 NOP 
      JSB .ENTR 
      DEF MESS5 
      LDA B6
      LDB MES05 
      JSB MESSI 
      OCT 2 
      JMP MESS5,I 
* 
B6    OCT 6 
* 
MES05 DEF *+1 
      ASC 3,"LIST"
* 
*  EOF    (END OF FILE) 
* 
MESS6 NOP 
      JSB .ENTR 
      DEF MESS6 
      LDA B3
      LDB MES06 
      JSB MESSI 
      OCT 2 
      JMP MESS6,I 
* 
B3    OCT 3 
* 
MES06 DEF *+1 
      ASC 2,EOF 
* 
*  "BRANCH TABLE GENERATOR" 
* 
MESS7 NOP 
      JSB .ENTR 
      DEF MESS7 
      LDA D24 
      LDB MES07 
      JSB MESSI 
      OCT 2 
      JMP MESS7,I 
* 
D24   DEC 24
* 
MES07 DEF *+1 
      ASC 12,"BRANCH TABLE GENERATOR" 
      SKP 
* 
*  "REWIND SOURCE FILE" 
* 
MESS8 NOP 
      JSB .ENTR 
      DEF MESS8 
      LDA D20 
      LDB MES08 
      JSB MESSI 
      OCT 2 
      JMP MESS8,I 
* 
D20   DEC 20
* 
MES08 DEF *+1 
      ASC 10,"REWIND SOURCE FILE" 
* 
*  -   (PROMPT) 
* 
MESS9 NOP 
      JSB .ENTR 
      DEF MESS9 
      LDA B2
      LDB MES09 
      JSB MESSI 
      OCT 2 
      JMP MESS9,I 
* 
MES09 DEF *+1 
      OCT 26537 
* 
*  "MNEMONIC TABLE GENERATOR" 
* 
MES10 NOP 
      JSB .ENTR 
      DEF MES10 
      LDA D26 
      LDB ME010 
      JSB MESSI 
      OCT 2 
      JMP MES10,I 
* 
ME010 DEF *+1 
      ASC 13,"MNEMONIC TABLE GENERATOR" 
* 
D26   DEC 26
* 
*  PENDING LINE IS OUTPUT 
* 
IBUF0 NOP 
LEN3  NOP 
MESSA NOP 
      JSB .ENTR 
      DEF IBUF0 
      LDA LEN3,I
      CMA,INA 
      LDB IBUF0 
      JSB MESSI 
      OCT 2 
      JMP MESSA,I 
      SKP 
* 
* 
*  ERROR MESSAGES 
* 
* 
* 
*  GTFIL ERROR
* 
* 
ERR1A NOP 
      JSB .ENTR 
      DEF ERR1A 
      LDA D9
      LDB ERR01 
      JSB MESSI 
      OCT 2 
      JMP ERR1A,I 
* 
D9    DEC 9 
* 
ERR01 DEF *+1 
      ASC 5,GTFIL ERR 
* 
*  COMMAND ERROR
* 
ERR2  NOP 
      JSB .ENTR 
      DEF ERR2
      LDA D11 
      LDB ERR02 
      JSB MESSI 
      OCT 2 
      JMP ERR2,I
* 
D11   DEC 11
* 
ERR02 DEF *+1 
      ASC 6,COMMAND ERR 
* 
*  OPEN ERROR 
* 
ERR3  NOP 
      JSB .ENTR 
      DEF ERR3
      LDA D8
      LDB ERR03 
      JSB MESSI 
      OCT 2 
      JMP ERR3,I
* 
D8    DEC 8 
* 
ERR03 DEF *+1 
      ASC 4,OPEN ERR
      SKP 
* 
*  READ ERROR 
* 
ERR4  NOP 
      JSB .ENTR 
      DEF ERR4
      LDA D8
      LDB ERR04 
      JSB MESSI 
      OCT 2 
      JMP ERR4,I
* 
ERR04 DEF *+1 
      ASC 4,READ ERR
* 
*  CLOSE ERROR
* 
ERR5  NOP 
      JSB .ENTR 
      DEF ERR5
      LDA D9
      LDB ERR05 
      JSB MESSI 
      OCT 2 
      JMP ERR5,I
* 
ERR05 DEF *+1 
      ASC 5,CLOSE ERR 
* 
*  WRITE ERROR
* 
ERR6  NOP 
      JSB .ENTR 
      DEF ERR6
      LDA D9
      LDB ERR06 
      JSB MESSI 
      OCT 2 
      JMP ERR6,I
* 
ERR06 DEF *+1 
      ASC 5,WRITE ERR 
      SKP 
* 
*  ADD ERROR
* 
ERR7  NOP 
      JSB .ENTR 
      DEF ERR7
      LDA B7
      LDB ERR07 
      JSB MESSI 
      OCT 2 
      JMP ERR7,I
* 
ERR07 DEF *+1 
      ASC 4,ADD ERR 
* 
*  SEQ ERROR
* 
ERR8  NOP 
      JSB .ENTR 
      DEF ERR8
      LDA B7
      LDB ERR08 
      JSB MESSI 
      OCT 2 
      JMP ERR8,I
* 
ERR08 DEF *+1 
      ASC 4,SEQ ERR 
* 
*  LINE ERROR 
* 
ERR9  NOP 
      JSB .ENTR 
      DEF ERR9
      LDA D8
      LDB ERR09 
      JSB MESSI 
      OCT 2 
      JMP ERR9,I
* 
ERR09 DEF *+1 
      ASC 4,LINE ERR
* 
*  REPL ERROR 
* 
ERR10 NOP 
      JSB .ENTR 
      DEF ERR10 
      LDA D8
      LDB ER010 
      JSB MESSI 
      OCT 2 
      JMP ERR10,I 
* 
ER010 DEF *+1 
      ASC 4,REPL ERR
      SKP 
* 
*  SYN ERR IN LINE XXX
* 
LINE  NOP 
ERR11 NOP 
      JSB .ENTR 
      DEF LINE
      LDA LINE,I    LINE NUMBER 
      STA NUMB1 
      JSB CNUMD     CONVERT TO ASCII
      DEF *+3 
      DEF NUMB1     AND PUT IN OUTPUT BUFFER
      DEF ER11P 
      LDA D22 
      LDB ER011 
      JSB MESSI 
      OCT 2 
      JMP ERR11,I 
* 
ER011 DEF *+1 
      ASC 8,SYN ERR IN LINE 
ER11P BSS 3 
* 
D22   DEC 22
* 
*  CREATE ERROR 
* 
ERR12 NOP 
      JSB .ENTR 
      DEF ERR12 
      LDA D10 
      LDB ER012 
      JSB MESSI 
      OCT 2 
      JMP ERR12,I 
* 
D10   DEC 10
* 
ER012 DEF *+1 
      ASC 5,CREATE ERR
* 
*  REWIND ERROR 
* 
ERR13 NOP 
      JSB .ENTR 
      DEF ERR13 
      LDA D10 
      LDB ER013 
      JSB MESSI 
      OCT 2 
      JMP ERR13,I 
* 
ER013 DEF *+1 
      ASC 5,REWIND ERR
      SKP 
* 
* 
*  SUBROURINE TO DETERMINE BRANCH-MNEMONIC TABLE
*  COMMAND (EDIT, TABLE, LIST, OR END)
* 
* 
FUNC1 NOP 
ERRP1 NOP 
READ1 NOP 
      JSB .ENTR 
      DEF FUNC1 
      JSB READX     GET INPUT FROM SESSION CONSOLE
      LDA M4        DETERMINE COMMAND 
      LDB CTABL 
      JSB SCAN
      JMP R1ERR     ERROR 
      CLB           SET TO NO ERROR 
RD1ER STA FUNC1,I   SAVE COMMAND TYPE 
      STB ERRP1,I   SAVE ERROR TYPE 
      JMP READ1,I 
R1ERR CLB,INB 
      CLA 
      JMP RD1ER 
* 
M4    DEC -4
* 
* 
*  SUBROUTINE TO DETERMINE EDIT COMMAND 
*  (END, ABORT, ADD, DELETE, FIND, REPLACE, 
*  FIND(/)-NEXT LINE
* 
FUNC2 NOP 
NUMB  NOP 
ERRP2 NOP 
READ2 NOP 
      JSB .ENTR 
      DEF FUNC2 
      JSB READX     GET INPUT FROM SESSION CONSOLE
      LDA M7
      LDB ETABL 
      JSB SCAN      DETERMINE EDIT COMMAND
      JMP R2ERR     ERROR 
      STA FUNC2,I   SAVE EDIT COMMAND TYPE
      JSB PNMRA     PARSE FOR # IN DEL AND FIND COMMANDS
      CLA           NO LINE NUMBER
      CLB           NO ERROR
RD2ER STA NUMB,I    SAVE LINE NUMBER
      STB ERRP2,I   SAVE ERROR CODE 
      JMP READ2,I 
R2ERR CLB,INB       ERROR 
      CLA           SET FOR NO FUNCTION 
      STA FUNC2,I 
      JMP RD2ER 
* 
M7    DEC -7
      SKP 
* 
*  COMMAND AND EDIT LOOK-UP TABLES. 
* 
*  BITS 15-8   #CHARS IN ASCII KEYWORD TABLE
*  BITS  7-0   OFFSET IN THAT TABLE(TO LOCATE ASCII WORDS)
* 
*     THE ORDER OF ENTRIES IN THESE TABLES IS USED IN DETERMINING 
*     THE OFFSET ASSOCIATED WITH KEYWORDS. THUS ORDER IN THIS 
*     TABLE IS OF PARAMOUNT IMPORTANCE. 
* 
* 
*  COMMAND LOOK-UP TABLE
* 
CTABL DEF CTABS 
CTABS ABS 2000B+AEDIT-CMTBL     EDIT
      ABS 2400B+ATABL-CMTBL     TABLE 
      ABS 2000B+ALIST-CMTBL     LIST
      ABS 1400B+AEND-CMTBL      END 
* 
*  EDIT LOOK-UP TABLE 
* 
ETABL DEF ETABS 
ETABS ABS 1400B+AEND-CMTBL      END 
      ABS 2400B+ABORT-CMTBL     ABORT 
      ABS 1400B+ADD-CMTBL       ADD 
      ABS 3000B+ADELE-CMTBL     DELETE
      ABS 2000B+AFIND-CMTBL     FIND
      ABS 3400B+AREPL-CMTBL     REPLACE 
      ABS 400B+ASLSH-CMTBL      FIND(/)-NEXT LINE 
* 
*  ASCII KEYWORD TABLE
*  ORDER OF ENTRIES IN THIS TABLE IS OF NO IMPORTANCE.
* 
CMTBL DEF * 
AEDIT ASC 2,EDIT
ATABL ASC 3,TABLE 
ALIST ASC 2,LIST
AEND  ASC 2,END 
ABORT ASC 3,ABORT 
ADD   ASC 2,ADD 
ADELE ASC 3,DELETE
AFIND ASC 2,FIND
AREPL ASC 4,REPLACE 
ASLSH ASC 1,/ 
      SKP 
* 
*  SUBROUTINE TO INPUT FROM SESSION CONSOLE FOR 
*  ADD EDIT COMMAND.
* 
IBUF  NOP 
LEN   NOP 
READ3 NOP 
      JSB .ENTR 
      DEF IBUF
      LDA D72       BUFFER LENGTH 
      LDB IBUF      BUFFER ADDRESS
      JSB MESSI     READ UP TO 72 CHARACTERS
      OCT 1 
      STB TEMP1     SAVE CHARACTER LENGTH 
      INB           CONVER TO # OF WORDS
      BRS 
      STB LEN,I     AND SAVE
      STB 0 
      LDB IBUF,I    ADD BLANK TO LAST 
      ADB 0         CHARACTER OF LAST WORD
      ADB M1        ONLY IF ODD # OF CHARACTERS 
      LDA TEMP1 
      SLA,RSS 
      JMP READ3,I   EVEN # OF CHARACTERS, EXIT
      LDA 1,I 
      AND UPCM
      IOR B40 
      STA 1,I 
      JMP READ3,I 
* 
TEMP1 NOP 
* 
D72   DEC 72
* 
*  SUBROUTINE TO READ FROM SESSION CONSOLE
* 
READX NOP 
      LDA D72       BUFFER LENGTH 
      LDB QBUFA     BUFFER ADDRESS
      JSB MESSI     READ FROM CONSOLE 
      OCT 1 
      STB QQCHC     SAVE # OF CHARACTERS
      CLA           RESET INCOMING
      STA QQCNT     CHARACTER POINTERS
      LDA QBUFA 
      STA QQPTR 
      JMP READX,I 
* 
QBUFA DEF QIBUF 
QIBUF BSS 72
* 
QQCHC NOP 
QQCNT NOP 
QQPTR NOP 
      SKP 
* 
*  SUBROUTINE TO OUTPUT THE NAM RECORD BMTBL
* 
*       NAM BMTBL 
* 
* 
IBUF1 NOP 
NAMRC NOP 
      JSB .ENTR 
      DEF IBUF1 
      LDA IBUF1     OUTPUT BUFFER ADDRESS 
      LDB TABL1     NAM RECORD DATA 
      JSB STORE     PUT DATA IN OUTPUT BUFFER 
      DEC -17       DATA BUFFER LENGTH
      JMP NAMRC,I 
* 
*  NAM RECORD DATA
* 
TABL1 DEF *+1 
      OCT 10400 
      OCT 20000 
      OCT 1256
      OCT 41115 
      OCT 52102 
      OCT 46040 
      OCT 177777
      OCT 0 
      OCT 0 
      OCT 0 
      OCT 0 
      OCT 0 
      OCT 0 
      OCT 0 
      OCT 0 
      OCT 0 
      OCT 0 
      SKP 
* 
*  SUBROUTINE TO OUTPUT THE ENT RECORD BRTBL
* 
*     ENT BRTBL 
* 
* 
IBUF2 NOP 
ENTBT NOP 
      JSB .ENTR 
      DEF IBUF2 
      LDA IBUF2     OUTPUT BUFFER ADDRESS 
      LDB TABL2     ENTRY RECORD DATA 
      JSB STORE     PUT DATA IN OUTPUT BUFFER 
      DEC -7        DATA BUFFER LENGTH
      JMP ENTBT,I 
* 
*  ENT RECORD DATA
* 
TABL2 DEF *+1 
      OCT 3400
      OCT 40001 
      OCT 21225 
      OCT 41122 
      OCT 52102 
      OCT 46000 
      OCT 0 
      SKP 
* 
*  SUBROUTINE TO OUTPUT THE DBL RECORD BRTBL DEF *+1
* 
*     BRTBL DEF *+1 
* 
IBUF3 NOP 
ENTBR NOP 
      JSB .ENTR 
      DEF IBUF3 
      CLA,INA       SET 
      STA LDADR     LOAD ADDRESS
      STA IDNUM     AND EXTERNAL ID NUMBER TO 1 
      LDA B4400     SET RECORD COUNT TO 9 WORDS 
      STA RLCNT 
      LDA B6014     SET WORD 2 OF DBL RECORD TO PROGRAM 
      STA INSTR     FOR LOAD ADD. & 4 FOR # INST. WORDS 
      LDA MNEG      SET RELOCATION INDICATOR TO 
      STA RLIND     EXTERNAL REFERENCE
      LDA IBUF3     OUTPUT BUFFER ADDRESS 
      LDB TABL3     DBL RECORD DATA 
      JSB STORE     PUT DATA IN OUTPUT BUFFER 
      DEC -6        DATA BUFFER LENGTH
      JMP ENTBR,I 
* 
*  DBL RECORD DATA
* 
TABL3 DEF *+1 
      OCT 3000
      OCT 60101 
      OCT 100102
      OCT 0 
      OCT 20000 
      OCT 1 
* 
B4400 OCT 4400
B6014 OCT 60104 
MNEG  OCT 100000
      SKP 
* 
*  SUROUTINE TO PUT THE NAM, ENT, EXT, DBL, AND END 
*  RECORDS IN THE OUTPUT BUFFER.
* 
STORE NOP 
      STA IBUFF     OUTPUT BUFFER 
      STB TABL      ADDRESS OF RECORDS
      LDA STORE,I   GET DATA BUFFER LENGTH
      STA COUNT 
STOR1 LDA TABL,I    GET NEXT DATA WORD
      STA IBUFF,I   STORE IN OUTPUT BUFFER
      ISZ TABL      INCREMENT TO NEXT DATA WORD 
      ISZ IBUFF     INCREMENT TO NEXT OUTPUT BUF ADD
      ISZ COUNT     DONE? 
      JMP STOR1     NO
      ISZ STORE     SET RETURN ADDRESS
      JMP STORE,I 
* 
COUNT NOP 
IBUFF NOP 
TABL  NOP 
      SKP 
* 
*  SUBROUTINE TO PARSE SOURCE FILE AND CREATE 
*  RELOCATEABLE BRANCH TABLE OUTPUT.
* 
IBUF4 NOP 
LEN1  NOP 
IBUF5 NOP 
IBUF6 NOP 
IERR1 NOP 
PARS1 NOP 
      JSB .ENTR 
      DEF IBUF4 
      LDA IERR1     SET ERROR RETURN ADDRESS
      STA IERR
      LDA LEN1,I    INPUT LENGTH
      LDB IBUF4     INPUT ADDRESS 
      JSB INIT      GO INITIALIZE 
      LDA IBUF5     CREATE EXTERNAL RECORD AND PUT IN 
      JSB EXTRC     OUPUT BUFFER
      JSB PRAMS     CHECK IF THERE ARE ANY PARAMETERS 
      JMP PARSC     NO PARAMETERS, INPUT BUFFER EMPTY 
      JMP PARSB     NO PARAMTERS, CHECK FOR FUNCTION TYPE 
PARSA JSB PARAM     CHECK PARAMETER TYPES 
      ISZ PRMCT     INCREMENT # OF PARAMETERS 
      JSB OTPUT     FORMAT OUTPUT WORD
      JSB EPRAM     DONE WITH PARAMETERS? 
      JMP PARSA     NO, GET NEXT ONE
      JMP PARSC     YES, INPUT BUFFER EMPTY 
PARSB JSB INTRL     CHECK FOR FUNCTION TYPE 
      JMP PARSC     NO ENTRY POINT NAME 
      JSB TEQUL     CHECK NEXT 2 CHARS FOR "T=" 
      LDA IBUF5     REPROCESS ENTRY POINT NAME
      JSB EXTRC     AND OVERLAY SUBROUTINE NAME 
PARSC LDA WORDX     SET WORD 9 BIT 15 IN DBL RECORD 
      IOR WORD3     IF FUNCTION IS AN INTEGER 
      STA WORD3 
      LDA FTN       SET WORD 8 BIT 15 IN DBL RECORD 
      IOR WORD2     IF FTN
      STA WORD2 
      LDA IBUF6     PUT DBL RECORD IN OUTPUT BUFFER 
      JSB DBLRC 
      ISZ IDNUM     INCREMENT EXT ID NUMBER 
      JMP PARS1,I 
* 
IERR  NOP 
PRMCT NOP 
WORDX NOP 
      SKP 
* 
*  SUBROUTINE TO INITIALIZE BRANCH AND
*  MNEMONIC TABLE GENERATOR 
* 
INIT  NOP 
      SZA,RSS 
      JMP ERR1
      RAL 
      STA QQCHC     SAVE # OF CHARACTERS
      CLA 
      STA QQCNT     RESET INCOMING CHAR POINTER 
      STA WORD1     INITIALIZE
      STA WORD2        OUTPUT 
      STA WORD3           BUFFER
      STA WORDX              ENTRIES
      STA PRMCT     # OF PARAMETERS 
      STA CHRCT     # OF CHARS. IN SUB. NAME
      STA IERR,I    CLEAR ERROR CODE
      STA FUNC      CLEAR FUNCTION BIT
      STA FTN       CLEAR FTN BIT 
      STB QQPTR 
      JMP INIT,I
* 
FTN   NOP 
FUNC  NOP 
* 
ERR1  CLA,INA       SET FOR ERROR RETURN
      STA IERR,I
      JMP PARS1,I 
      SKP 
* 
*  SUBROUTINE TO GENERATE AN EXTERNAL RECORD FOR THE NAME OF THE
*  FUCTION OR SUBROUTINE. IF ENTRY IS SUPPLIED, IT WILL OVERLAY 
*  THE FUNCTION OR SUBROUTINE NAME FOR BRANCH TABLE ENTRIES.
* 
* 
EXTRC NOP 
      STA IBUFF     DESTINATION ADDRESS 
      LDB BLANK     INITIALIZE
      ADA B4           OUTPUT BUFFER
      STB 0,I 
      INA 
      STB 0,I 
      LDA B3000     RECORD LENGTH 
      STA IBUFF,I 
      ISZ IBUFF 
      LDA B1001     RECORD IDENT-# ENTRIES
      STA IBUFF,I 
      ISZ IBUFF 
      ISZ IBUFF 
      LDA IBUFF     DESTINATION ADDRESS 
      JSB MOVE.     MOVE SYMBOL NAME FROM INPUT BUFFER
      ISZ IBUFF 
      ISZ IBUFF 
      LDA IBUFF,I   SET EXTERNAL ID NUMBER
      AND UPCM
      IOR IDNUM 
      STA IBUFF,I 
      LDA IBUF5 
      STA IBUFF 
      ADA B3
      LDB 0,I       CALCULATE CHECKSUM
      INA 
      ADB 0,I 
      INA 
      ADB 0,I 
      ADB B1001 
      LDA IBUFF     AND STORE IN WORD3
      ADA B2
      STB 0,I       OF EXTERNAL RECORD
      JMP EXTRC,I 
* 
B2    OCT 2 
BLANK OCT 20040 
B3000 OCT 3000
B1001 OCT 100001
UPCM  OCT 77400 
      SKP 
* 
*  SUBROUTINE TO CHECK IF THERE ARE ANY PARAMETERS
* 
PRAMS NOP 
      CLA           INITIALIZE PARAMETER COUNT
      STA PRMCT 
      JSB NXTC      GET NEXT NON BLANK CHARACTER
      JMP PRAMS,I   NO MORE 
      ISZ PRAMS 
      CPA COMMA     IF COMMA, NO PARAMETERS 
      JMP PRAMS,I   NO PRAMS., EXIT 
      CPA LPARN     MUST HAVE LEFT PARENTHESIS
      RSS 
      JMP ERR1      NONE, ERROR EXIT
      ISZ PRAMS     SET RETURN ADDRESS
      JMP PRAMS,I 
* 
LPARN OCT 50
      SKP 
* 
*  SUBROUTINE TO DETERMINE TYPE OF PARAMETER. 
*  POSSIBLE TYPES (I,R,IA,RA,IV,RV,IVA,RVA).
* 
*  0 = I
*  1 = R
*  2 = IA 
*  3 = RA 
*  4 = IV 
*  5 = RV 
*  6 = IVA
*  7 = RVA
* 
*  ABOVE VALUES STORED IN "TYPE" ON EXIT. 
* 
PARAM NOP 
      CLB 
      STB TYPE      INIT TYPE 
      JSB NXTC      GET NEXT CHAR.
      JMP ERR1      NONE, ERROR EXIT
      CPA I         = I?
      JMP PARA1     YES 
      CPA R         = R?
      RSS           YES 
      JMP ERR1      NO, ERROR EXIT
      ISZ TYPE
PARA1 JSB NXTC      GET NEXT CHARACTER
      JMP ERR1      NO MORE, ERROR EXIT 
      LDB B2
      CPA RPARN     RIGHT PARENTHESIS?
      JMP PARA3     YES, EXIT 
      CPA COMMA     COMMA?
      JMP PARA3     YES, EXIT 
      CPA A         = A?
      JMP PARA4     YES 
      CPA V         = V?
      RSS           YES 
      JMP ERR1      NO, ERROR EXIT
      LDB B4
      ADB TYPE
      STB TYPE
      JSB NXTC      GET NEXT CHARACTER
      JMP ERR1      NO MORE, ERROR EXIT 
      CPA A         = A?
      JMP PARA5     YES 
PARA6 CPA RPARN     RIGHT PARENTHESIS?
      JMP PARA3     YES, EXIT 
      CPA COMMA     COMMA?
      JMP PARA3     YES, EXIT 
      JMP ERR1      NO, ERROR EXIT
PARA5 LDB TYPE      SET PARAMTER TYPE 
      ADB B2
      STB TYPE
      JMP PARAM,I 
* 
PARA3 JSB BAKUP     BAKUP INPUT STRING
      JMP PARAM,I 
* 
PARA4 ADB TYPE
      STB TYPE
      JSB NXTC      GET NEXT CHARACTER
      JMP ERR1      NO MORE 
      JMP PARA6 
* 
A     OCT 101 
I     OCT 111 
R     OCT 122 
V     OCT 126 
* 
TYPE  NOP 
      SKP 
                                                          