ASMB,R,L,C
      HED FMGR
*     NAME:   FMGR
*     SOURCE: 92064-18150 
*     RELOC:  92064-16055 
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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.       *
*  ***************************************************************
* 
* 
      NAM FMGR,1,80  92064-16055  REV.1709  770223
* 
* 
      ENT FMGR,N.OPL,ELOG.,AB.FM,FM.AB
      ENT TMP.,MSS.,C.BUF,LODCB 
      EXT OPEN,READF,DTTY,RMPAR,WRITF,.MVW
      EXT $CON,EXEC,.ENTR,IDCB1,.E.R,LIMEM,$CDIR
      EXT CONV.,OPEN.,CLO,.DRCT,MGLU,IMESS,IDCB2
      EXT $LIBR,$LIBX 
      SUP 
* 
* 
CON1  NOP 
N20K  OCT 160000
* 
ONP1  NOP 
ONP2  NOP 
ONP3  NOP 
ONP4  NOP 
ONP5  NOP 
* 
FMGR  JSB RMPAR     FETCH 
       DEF *+2           THE
ONP1A  DEF ONP1     5 TURN ON PARMS 
* 
* 
BOOT  JMP INITD     GO INITIALIZE THE MASTER DIRECTORY
* 
BOOT1 LDA $CON,I    FETCH TERMINAL LU 
      AND B77       ISOLATE IT
      STA CON1      AND SAVE IT 
* 
*  1ST PARM CHECKS
* 
      LDA ONP1      FETCH PARM1 
      LDB N20K      FETCH MIN ASCII WD
      ADB A         IS THIS A ANSWER FILE?
      SSB,RSS       WELL? 
      JMP ITNME     YES--CONTINUE 
* 
      SZA,RSS       IF DEFAULT
USEC  LDA CON1          USE CORRECT CONSOLE 
      STA ONP1      SAVE CORRECT VALUE FOR OTHER CHECKS 
      JSB DTTY      INTERACTIVE?
      STA INT.      SAVE RESULT (0=NO, NON ZERO = YES)
* 
*    GET MAGIC NAME FOR THIS LU 
* 
      JSB MGLU
      DEF *+3 
      DEF ONP1
OBF   DEF C.BUF 
* 
      LDA OBF       FETCH ADDRESS OF NAME 
      JSB OPIN      GO TRY TO OPEN IT(ERRORS RETURN TO USEC)
* 
      JMP USEC      BAD RETURN FROM OPEN--USE CONSOLE 
* 
      LDA ONP2      FETCH LOG  (NORMAL RETURN)
      SZA,RSS       DEFAULT?
      JMP W2K       YEP--GO FIND SOMETHING TO USE 
* 
*  LOG GIVEN--MUST BE INTERACTIVE 
* 
      JSB DTTY      VERIFY THAT IT IS INTERACTIVE 
      LDB ONP2      FETCH LOG IN CASE IT OK 
      SZA           WELL? 
      JMP W3K       ----IT'S INTERACTIVE----CONTINUE
* 
*   LOG NOT INTERACTIVE 
*    ISSUE BAD PARM ERROR CODE
*    THEN USE CORRECT TERMINAL
* 
      LDA .56       FETCH ERROR CODE
      STA ER        SET IT
      JSB ONER      USE IMESS FOR BOOT UP ERROR 
* 
* 
*   LOG NOT GIVEN OR NOT INTERACTIVE
* 
W2K   LDA INT.      WAS INPUT INTERACTIVE?
      LDB ONP1      FETCH IT IN CASE IT WAS 
      SZA,RSS       WELL? 
WKFL  LDB CON1      NOPE--USE CONSOLE 
W3K   STB ONP2      SET NEW LOG LU
      JSB MGLU      GO GET MAGIC NAME FOR IT
      DEF *+3 
      DEF ONP2      ADDRESS OF NUMBER TO BE CONVERTED 
      DEF C.BUF     TEMP AREA FOR RESULT
* 
*  GO OPEN HER UP 
* 
      JSB OPEN
       DEF O.2R 
DLO$   DEF LODCB
       DEF ER 
       DEF C.BUF
       DEF OPOPT
* 
O.2R  SSA,RSS       ANY PROBLEMS? 
      JMP LSTWK 
* 
*   ISSUE ERROR MESSAGE THEN TRY AGAIN USING CONSOLE
* 
      JSB ONER
      JMP WKFL
* 
* 
*   OPIN OPENS THE INPUT FILE/DEVICE
*     LDA ADDR      ADDRESS OF NAME TO BE OPENED
*     JSB OPIN
* 
*     P+1=OPEN ERROR WAS FOUND--ERROR HAS BEEN ISSUED 
*     P+2=NORMAL RETURN 
* 
OPIN  NOP 
      STA INME
      JSB OPEN
       DEF O.1R 
DIN$   DEF INDCB
       DEF ER 
INME  NOP           ADDRESS OF BUF HOLDING NAME GOES HERE 
       DEF OPOPT    OPEN OPTION 
* 
O.1R  SSA,RSS       ANY ERRORS? 
      JMP GDD       NOPE--GO EXIT P+2 
* 
      JSB ONER      ISSUE ERROR CODE
      JMP OPIN,I    RETURN P+1  (BAD RETURN)
* 
GDD   ISZ OPIN      ADVANCE TO GOOD RETURN
      JMP OPIN,I    RETURN
* 
* 
ONER  NOP 
      LDA ER
      JSB STER      GO SET UP ERROR MESS
      JSB IMESS 
      DEF RTRN
      DEF .2
      DEF ERMES 
      DEF .5
RTRN  JMP ONER,I
* 
* 
* 
* 
      SPC 5 
* 
*   INPUT IS A FILE NAME
* 
ITNME LDA ONP1A     FETCH ADDRESS OF NAME 
      JSB OPIN      GO OPEN IT
      JMP NOGD      ERROR FROM OPEN--SET UP TO USE DEFAULTS 
* 
      LDB DIN$       OPEN WAS OK--NOW 
      ADB .2         SEE IF IT'S INTERACTIVE
      LDA B,I       FETCH TYPE WORD 
      SZA           CONTINUE IF ZERO
      JMP NZRO      ELSE SET IT NON-INTERACTIVE 
      INB           ADVANCE TO LU 
      LDA B,I       FETCH LU -DTTY ISOLATES IT
      STA EX!       SAVE IT IN TEMP 
      JSB DTTY
STINT STA INT.
      LDB ONP5      FETCH LIST PARM 
      STB ONP3      SET FOR NORMAL LIST PROCESSING
      SZA,RSS       USE THIS LU IF INTERACTIVE
      JMP WKFL      GO SET CONSOLE AS LOG DEVICE
* 
      LDB EX!       FETCH LU
      JMP W3K       GO USE SAME LU AS LOG 
* 
NZRO  CLA 
      JMP STINT     GO SET INPUT INTERACTIVE FLAG FALSE 
* 
* 
NOGD  LDA CON1      FETCH CONSOLE LU
      STA ONP2      SET AS LOG
      LDA ONP5
      STA ONP3      SET LIST
      JMP USEC      GO DO EVERYTHING DEFAULT
* 
* 
LSTWK LDA ONP3      FETCH LIST LU 
      SZA,RSS       SKIP IF NOT DEFAULT 
      LDA .6        DEFAULT TO LU 6 
      STA TMP.      SAVE IT FOR USE BY SUBS 
* 
      LDA DIN$      ADDRESS OF INPUT DCB
      STA IN$       SET AS CURRENT INPUT FILE 
* 
      JSB CLOAL      CLOSE ALL FILES
      SPC 10
* 
*   COMMAND INPUT FILE OPEN-- 
*     FETCH AND PARSE NEXT COMMAND
* 
NXCM  JSB RE.C      GO GET A COMMAND
      CLA           CLEAR COMMAND ADDRESS IN CASE 
      STA CMAD      ONLY BLANKS OR CONTROL IS ENTERED 
* 
      JSB PARS      GO PARSE IT 
* 
* 
      LDA CMAD      FETCH COMMAND ADDRESS 
      SZA,RSS       IF ZERO THEN 0 NON-BLANK CHARS HAVE BEEN ENTERED
      JSB CMND?     ERROR-- 
* 
*   COMMAND HAS BEEN IDENTIFIED AND ADDRESS IS IN CMAD
* 
      CLA           CLEAR OUT 
      STA ER          ERROR WORDS 
      STA .E.R
* 
      JSB CMAD,I    CALL THE ACTION ROUTINE 
      DEF CALR
      DEF P.CNT 
      DEF P.RAM 
      DEF ER
* 
CALR  LDA ER
      SZA,RSS 
      JMP SHUT
      JMP ELOG. 
      SPC 5 
* 
* 
ER    NOP 
INDCB BSS 144 
* 
      ORG INDCB     FORCE BOOT-UP CODE INTO DCB 
* 
INITD LDA $CDIR     FETCH FIRST WORD OF DIRECTORY 
      SSA,RSS       CONTINUE ONLY IF NOT DONE 
      JMP XGOOD     ELSE EXIT 
* 
      JSB OPEN      FORCE CALL TO D.RFP 
      DEF XRTN
      DEF LODCB 
      DEF XER 
      DEF XNAM
* 
XRTN  CPA XN100     ONLY BAD RETURN IS -100 
      JMP XBAD
* 
* 
XGOOD CLA           REMOVE
      STA BOOT      JMP INITD 
      JMP BOOT1 
* 
* 
XBAD  JSB IMESS 
      DEF XRTN2 
      DEF X.2 
      DEF XBUF
      DEF XLEN
* 
XRTN2 JSB $LIBR     GO PRIV 
      NOP              AND CLEAR BOOT FLAG
      CLA               ($CDIR= NEG DISK LU)
      STA $CDIR            (MAKE IT =0) 
      JSB $LIBX 
      DEF *+1 
      DEF XGOOD     CONTINUE AFTER MESSAGE
* 
* 
X.2   OCT 2 
X.5   OCT 5 
XN100 DEC -100
XER   NOP 
XNAM  ASC 3,---- -
XLEN  DEC 20
* 
XBUF  ASC 20, FMGR -100  (LU 2 MUST BE INITIALIZED) 
* 
* 
      ORR 
      SPC 5 
* 
* 
* 
TMP.  NOP 
TMP.2 OCT 0,0 
SC.L  NOP 
CRLU  NOP 
      SPC 10
AB.FM LDA .E.R
      JMP ELOG. 
* 
FM.AB EQU AB.FM 
      SPC 5 
MSCD  NOP 
MSCD2 NOP 
MSS.  NOP 
      JSB .ENTR 
      DEF MSCD
      LDA MSCD,I
* 
* 
* 
ELOG. JSB STER      GO SET UP ERROR MESS
      JSB WRITF 
      DEF ERMS
      DEF LODCB 
      DEF ER
      DEF ERMES 
      DEF .5
ERMS  LDA DLO$
      STA IN$       SWITCH TO LOG DEVICE FOR INPUT
      STA INT.      SET INTERACTIVE FLAG
* 
      JSB CLO       CLOSE THE INPUT FILE
      DEF INDCB 
* 
CLO2  CLB 
      LDA MSCD2 
      STB MSCD2     CLEAR PARM SO WE CAN EXIT 
      SZA 
      JMP MSS.2     YEP--SO ISSUE IT
      LDA MSS.
      STB MSS.
      SZA 
      JMP A,I 
* 
      JSB LIMEM      RELEASE MEMORY IN CASE PK ABORTED
      DEF SHUT
      DEF N1
* 
SHUT  JSB CLOAL 
* 
CLRTN JMP NXCM      GO GET NEXT COMMAND 
* 
* 
* 
MSS.2 LDA A,I       FETCH THE CODE
      JMP ELOG.     GO DO IT
* 
* 
* 
* 
STER  NOP 
      LDB BLK       IF NOT NEG USE BLANK
      SSA 
      LDB BSGN
      STB ESGN
      SSA 
      CMA,INA 
      STA OLDER     SAVE ERROR CODE 
      JSB CONV. 
      DEF CVTN
      DEF OLDER 
      DEF ECDE
      DEF .3
CVTN  JMP STER,I
* 
* 
* 
ZERO  NOP 
ERMES ASC 3,FMGR
ESGN  NOP 
ECDE  NOP 
* 
* 
* 
* 
BSGN  ASC 1,- 
BLK   ASC 1,
OLDER NOP 
      SPC 5 
ERR?  CLA 
      LDB IBP       FETCH CURRENT BYTE ADDRESS
      CLE,SLB,ERB   DETERMINE WHICH BYTE TO ZAP 
      LDA HBTE      SAVE HIGH BYTE
      AND B,I       ELSE USE 0
* 
      IOR B77       INCLUDE "?" 
      SEZ,RSS       IF CURRENT BYTE=HIGH RE-POSITION
      ALF,ALF 
      STA B,I       SET BACK INTO INPUT BUFFER
* 
*  DETERMINE ECHO LENGTH
* 
      ERB           SET CHAR FLAG INTO SIGN OF B
      LDA DNFLG     FETCH REMAINING COUNT (1'S COMP & BYTE) 
      SZA           SKIP COMP IF ZERO 
      CMA           MAKE IT POSITIVE
      CLE,ERA       MAKE IT WORDS 
      CMA,INA       SET COUNT NEG 
      ADA ECH       ADD TO ORGINIAL COUNT 
      CLE,ELA       MAKE IT BYTES 
      SSB,RSS       IF IT WAS HIGH BYTE 
      INA           BUMP CHAR COUNT 
      CMA,INA       SET IT NEG FOR CHAR COUNT 
      STA ECH       STORE PRINT LENGHT
      JSB ECHO      GO PRINT IT 
      LDA .10 
      STA .E.R
      JMP AB.FM 
* 
* 
HBTE  OCT 177400
* 
      SKP 
* 
* 
EX!   NOP 
* 
      JSB CLO 
      DEF INDCB      CLOSE INPUT FILE 
* 
* 
EXR1  JSB WRITF 
      DEF EXR3
      DEF LODCB 
      DEF ER
      DEF ENDM       ISSUE END FMGR MESSAGE 
      DEF .5         DON'T NEED TO CLOSE LOG AS IT MUST BE LU 
* 
EXR3  JSB CLOAL 
EXR4  JSB EXEC
      DEF *+2 
      DEF .6        TERMINATE 
* 
* 
ENDM  ASC 5,$END FMGR 
* 
* 
* 
*   CLOSE LIBRARY DCBS IDCB1 AND IDCB2
* 
CLOAL NOP 
      JSB CLO       CLOSE ROUTINE-- 
      DEF IDCB1         DIRECT CALLING SEQUENCE 
      JSB CLO 
      DEF IDCB2      CLOSE SECOND DCB 
      JMP CLOAL,I 
* 
* 
* 
* 
      SPC 10
* 
LLTMP NOP 
LLST  NOP 
LLER  NOP 
* 
LL!   NOP 
      JSB .ENTR 
      DEF LLTMP 
      ISZ LLST
      JSB OPEN. 
      DEF BKLL
      DEF IDCB1 
      DEF LLST,I
      DEF N.OPL 
      DEF B411
* 
BKLL  LDA LLST,I
      STA TMP.
      ISZ LLST
      DLD LLST,I
      DST TMP.2 
      JSB .DRCT 
      DEF N.OPL      ASSURE DIRECT ADDRESS
      LDB A,I 
      STB SC.L
      INA 
      LDB A,I 
      STB CRLU
      CLA 
      STA LLER,I
      JMP LL!,I 
* 
B411  OCT 411 
OPOPT EQU B411
* 
* 
* 
* 
      SPC 3 
******FETCH DIRECT ADDR******** 
* 
.ADDR NOP 
      RAL,CLE,ERA 
      SEZ 
      LDA A,I 
      JMP .ADDR,I 
* 
.56   DEC 56
* 
* 
* 
B77   OCT 77
* 
* 
.2    OCT 2 
.3    OCT 3 
.5    OCT 5 
.6    OCT 6 
.10   DEC 10
.36   DEC 36
* 
* 
      SPC 10
TCNT  NOP 
TLST  NOP 
TER   NOP 
* 
TR!   NOP 
      JSB .ENTR 
      DEF TCNT
      ISZ TLST      ADVANCE TO NAME/LU
* 
      LDA TLST,I    FETCH IT
      SZA,RSS 
* 
*   TRANSFER BACK TO THE LOG DEVICE 
* 
      JMP ERMS
* 
* 
OPITR JSB OPEN.     GO OPEN NEW TRANSFER FILE 
      DEF BACK
XX    DEF INDCB 
      DEF TLST,I
      DEF N.OPL 
      DEF OPOPT 
* 
BACK  LDA XX         FORCE INPUT DCB TO BE USED 
      STA IN$ 
      ADA .2        ADVANCE TO TYPE WORD
      LDB A,I       FETCH IT
      SZB           IF ZERO--CONTINUE 
      JMP DSFL      NOPE IT'S A DISK FILE 
      INA          ADVANCE TO LU WORD 
      LDA A,I       FETCH IT
      JSB DTTY
TRINT STA INT.      SET INTERACTIVE FLAG
      JMP TR!,I 
* 
DSFL  CLA           FORCE NOT INTERACTIVE 
      JMP TRINT 
      SKP 
* 
* 
* 
*   RE.C SHOULD DO THE FOLLOWING: 
*    1- DETERMINE IF INPUT FROM INTERACTIVE DEVICE
*       IF SO, PROMPT ON THAT DEVICE
*    2- READ FROM INPUT FILE/DEVICE 
*    3- IF ECHO REQUIRED-DO IT TO LOG 
* 
* 
*  GLOBALS
* 
* ECH CMND INPUT LEGNTH 
* INT.              INTERACTIVE FLAG
* C.BUF             CMND INPUT BUFFER 
* INDCB             INPUT DCB 
* 
.1    OCT 1 
* 
RE.C  NOP 
      LDA INT.      IF NOT INTERACTIVE
      SZA,RSS 
      JMP WR.1R     DON'T PROMPT
* 
      JSB WRITF 
       DEF WR.1R
       DEF IN$,I
       DEF TMP2 
       DEF PRM
       DEF .1 
* 
WR.1R JSB READF 
       DEF WR.2R
       DEF IN$,I
       DEF TMP2 
       DEF C.BUF
       DEF .36
       DEF ECH       LEGNTH PARM
* 
WR.2R SSA           IF ANY ERROR
      JMP WR.1R     RETRY 
* 
* 
      LDA ECH       IF EOF
      CPA N1        TRANSFER TO 
      JMP ERMS      LOG DEVICE
* 
* 
*   DO ECHO IF IN FROM NON INT WORK 
* 
* 
      LDA INT.      FETCH INTERACTIVE FLAG
      SZA,RSS 
      JSB ECHO      GO DO ECHO
      JMP RE.C,I     IT'S INTERACTIVE SO EXIT 
* 
      SPC 5 
N1    OCT -1
ECHO  NOP 
      JSB WRITF 
      DEF ECRT
      DEF LODCB 
      DEF TMP2
      DEF C.BUF 
      DEF ECH 
ECRT  JMP ECHO,I
IN$   NOP 
PRM   OCT 35137     BACK SPACE AND BACK ARROW 
* 
* 
* 
.88   DEC 88
* 
      SKP 
* 
* 
**********************************************
**********************************************
*******THE*PARSE*ROUTINE*MAY*BECOME*A*SEPERATE* 
****************SUBROUTINE********************
* 
* 
* 
*   PARSE ROUTINE 
* 
PARS  NOP 
      LDA ECH       RESET COMMAND LEGNTH
      CLE,ELA       CONVERT TO CHAR COUNT 
      CMA           SET NEGATIVE FOR GTCHR
      STA DNFLG 
      LDA CAM.A    RESET CHARACTER ADDRESS
      STA IBP       FOR INBUF SCAN
* 
* 
* 
       LDB INT.      FETCH INTERACTIVE FLAG 
       SZB           IF NOT INTERACTIVE-SKIP
       JMP OK:       --ELSE CONTINUE
* 
      JSB GTCHR 
       JMP ERR? 
* 
* 
       CPA CLN      MUST HAVE : FOR FIRST CHAR
       JMP OK:       GOT IT-CONTINUE
* 
       JMP ERR?      ELSE ISSUE ERROR AND TRANSFER TO LOG DEVICE
* 
       SPC 5
OK:    CLA           ZERO OUT POINTERS,BUFFERS
       STA MRSLT     WORK FIELDS AND FLAGS
       LDA MADDR     FETCH START ADDRESS (DEF MRSLT 
       STA B         AND FORM 
       INB                  RESULT FIELD ADDRESS
* 
       JSB .MVW      GO 
        DEF .88        CLEAR
        NOP                 THE WORLD 
* 
       LDA MADDR     FETCH ADDRESS OF MAIN RESULT 
       STA NXBUF     FIELD AND SET IT AS FIRST BUFFER 
       LDA .17       FETCH MAIN BUF CODE
       STA NXBC      SET AS NEXT BUF FLAG 
      LDA N2        SET FIRST FLAG FOR CMND CHECK 
      STA FIRST 
* 
       SKP
* 
TOP   ISZ FIRST     GOT CMND READY? 
      RSS           NOPE
      JSB CMND?      DOES NOT RETURN IF BAD CMND
* 
      LDA WORKA     RESET WORK BUF ADDRESS
      STA TMP1      FOR THIS PASS 
       LDA NXBUF     FETCH NEXT BUFFER ADDRESS
       STA CBUF      SET IT AS CURRENT BUFFER 
       LDA NXBC      SET CURRENT
       STA CXBC               BUFFER FLAG 
      CLA 
      STA FNDCT     CLEAR CHAR FOUND THIS PARM COUNT
* 
* 
* 
       LDB DNFLG     FETCH DONE FLAG
       SSB,RSS       IF MORE CHAR  --SKIP 
       JMP PARS,I    ELSE GO TO EXIT
* 
* 
NEXT   JSB GTCHR     FETCH NEXT NON-BLANK CHAR
        JMP CONV     -ALL DONE--SEE IF CONVERSION NEEDED
* 
       CPA CMA       IS IT A COMMA? 
       JMP GTCMA     YES-GO PROCESS IT
* 
       CPA CLN       IS IT A COLON? 
       JMP GTCLN     YES- GO PROCESS IT 
* 
*   NOT SURE ON THIS COUNT
* 
       LDB .8        CHECK FOR TOO MANY CHARS 
       CPB FNDCT     COMPARE AGAINST #FOUND 
       JMP NEXT      YES--DON'T SAVE  EXTRAS
* 
       STA TMP1,I    =LOCATION TO SAVE CHAR 
       ISZ FNDCT     BUMP CHAR FOUND COUNT
       ISZ TMP1      BUMP SAVE LOCATION 
* 
       JMP NEXT      GO GET NEXT CHAR 
* 
* 
FIRST NOP 
N2    OCT -2
* 
* 
      SPC 5 
* 
*    GOT A CMND--SEE IF IT IS LEGIT 
* 
* 
*           DETERMINE CMND TYPE 
* 
CMND? NOP 
      LDB MADDR     FETCH FLAG FOR
      LDA B,I            COMMAND--
      CPA .3        MUST BE ASCII 
      INB,RSS       YEP-- IT'S OK 
* 
      JMP ERR?      NOPE--BAD INPUT 
* 
* 
      LDA B,I       FETCH COMMAND 
      STA OPP       SET STOP WORD 
      LDB TABP      SET TABLE 
      STB TMP1          POINTER FOR SEARCH
      LDB ACTP      SET ACTION ADDRESS
      STB TMP2              FOR SEARCH
* 
SCH   CPA TMP1,I   THIS IT? 
      JMP CALL      YES--GO TO IT 
      ISZ TMP1     BUMP COMMAND POINTER 
      ISZ TMP2     BUMP ACTION POINTER
      JMP SCH       TRY AGAIN-- 
* 
* 
      SPC 2 
CALL  LDA TMP2      FETCH CMND ADDRESS
      CPA ERC       IF EQUAL TO ERROR ADDRESS 
      JMP ERR?          THEN GO NO FURTHER
* 
      STA CMAD      SET COMMAND ADDRESS 
      JMP CMND?,I 
* 
CMAD  NOP 
* 
TABP  DEF *+1 
      ASC  8,CRDUSTLIEXLLTRCN 
      ASC  9,INMCDCCLDLCOPUPKRN 
OPP   NOP           SET TARGET HERE 
* 
* 
ACTP  DEF *+1,I 
      EXT CR..
      DEF CR..
      EXT DU..
      DEF DU..
      EXT ST..
      DEF ST..
      EXT LI..
      DEF LI..
      DEF EX! 
      DEF LL! 
      DEF TR! 
      EXT CNT.
      DEF CNT.
      EXT IN..,RC..,MC..
      DEF IN..
      DEF MC..
      DEF RC..
      EXT CL..,DL..,CO..
      DEF CL..
      DEF DL..
      DEF CO..
      EXT PU..,PK..,CN..
      DEF PU..
      DEF PK..
      DEF CN..
ERC   DEF *,I       NOT FOUND --BAD INPUT 
* 
* 
.8    DEC 8 
.17   DEC 17
* 
       SKP
* 
* 
*    FOUND A COMMA
* 
GTCMA ISZ P.CNT      INC MAIN PARM COUNT
       LDA P.CNT     FETCH MAIN PARM COUNT
       RAL,RAL       MULT BY 4
       ADA MADDR     AND ADD BUFFER START ADDRESS 
       STA NXBUF     TO GET RESULT STARTING ADDRESS 
* 
       LDA .17       FETCH # MAX PARMS+1
       STA NXBC      SET AS NEXT BUF FLAG 
       CPA P.CNT     ALSO CHECK FOR TOO MANY PARAMETERS 
       JMP ERR?      --TOO MANY  BYE BYE
* 
       CLA           RESET SUB PARM COUNT 
       STA SPCNT
       JMP CONV      GO CONVERT PARM
* 
       SPC 5
* 
*   FOUND A COLON 
* 
GTCLN  LDA P.CNT     FETCH MAIN PARM COUNT
       ADA N2        BUT NO MORE THAN 2 
       LDB SPADR     FETCH SUB PARM BUFFER ADDRESS
       SSA           IF FOR FIRST MAIN PARM 
       JMP SET       GO SET BUFFER ADDRESS
* 
       SZA           IF MORE THAN 2ND PARM
       JMP ERR?      --TAKE ERROR EXIT
       ADB .5        ELSE ADVANCE TO 2ND MAIN FIELD 
* 
*   (B)= START OF SUB PARM FIELD
*    DETERMINE OFSET
* 
SET    ADB SPCNT     ADD CURRENT SUB PARM COUNT 
       STB NXBUF     SET AS NEXT RESULT BUFFER ADDRESS
       ISZ SPCNT     BUMP SUB PARM COUNT
       LDA .6        MAX # SUB PARMS +1 
      STA NXBC      SET SUB PARM AS NEXT RESULT FIELD 
       CPA SPCNT     SEE IF WE'VE GOT TOO MANY
       JMP ERR?      YEP--TAKE ERROR EXIT 
* 
*     THIS FALLS THRU TO CONVERT
* 
* 
       SPC 5
* 
* 
*      CONVERT ROUTINE
* 
CONV   LDA FNDCT     IF NO CHARS FOUND
       SZA,RSS       THEN EITHER DONE OR NULL 
       JMP NONE           GO CHECK
* 
       LDB WORKA     SET ADDRESS OF WORK
       STB TMP1      BUFFER  FOR CONVERSION 
       LDA B,I       FETCH FIRST CHAR 
* 
       CPA DASH      IF "-" GO SEE IF THATS ALL 
       JMP C. 
* 
      CPA PLUS      DO THE SAME 
      JMP C.               FOR "+"
* 
LSTT   ADB FNDCT     ADVANCE TO LAST CHAR ADDRESS 
      ADB N1
       LDA B,I       FETCH IT 
       CPA AS.B      CHECK FOR BASE INDICATOR 
       JMP .B        YES IT'S BASE 8
       INB           ADVANCE PAST LAST CHAR 
       LDA .10       FETCH FOR BASE 10 CONVERSION 
* 
STBS   STA BASE      SET BASE FOR CONVERSION
       STB STOP      SET STOP ADDRESS 
       CLB,CLE       CLEAR THE RESULT 
       STB VALUE     BUFFER 
* 
CMPY   MPY VALUE
       LDB TMP1,I    FETCH CURRENT CHARACTER
       ADB DM58      IF GREATER THAN "9"
       SEZ,CLE,RSS   THEN NOT A NUMBER
       ADB .10       IF LESS THAN "0" 
       SEZ,CLE,RSS        THEN NOT
       JMP ASCII           A NUMBER 
* 
       ADA B         INCLUDE PREVIOUS RESULT
       STA VALUE        AND SAVE IT 
* 
       ISZ TMP1      BUMP WORK BUFFER POINTER 
       LDA BASE      FETCH BASE FOR NEXT LOOP 
       LDB STOP      FETCH STOP ADDRESS 
       CPB TMP1      IF EQUAL TO CURRENT WORK POINTER 
       JMP CDNE      THEN CONVERSION COMPLETE 
       JMP CMPY      ELSE--CONTINUE CONVERSION
* 
* 
* 
       SPC 5
C.     ISZ TMP1 
       LDA FNDCT
       CPA .1 
       JMP ASCII
       JMP LSTT 
       SPC 5
.B     LDA .8        FETCH CONVERSION BASE
       JMP STBS 
* 
* 
* 
* 
* 
* 
*       CONVERSION DONE 
*        NUMERIC RESULT 
*         IN "VALUE"
* 
CDNE  LDA WORKA,I   FETCH FIRST CHAR
      LDB VALUE     FETCH CONVERTED VALUE 
      CPA DASH      IF ="-" THEN NEGATE 
      CMB,INB        RESULT 
* 
* 
*   DETERMINE WHERE RESULT GOES 
* 
      LDA CXBC      FETCH CURRENT BUFFER CODE 
      CPA .17       MAIN PARM BUF?
      JMP MAIN      YEP 
* 
*  GOES IN SUB PARM BUF 
* 
      STB CBUF,I    SAVE RESULT IN BUFFER 
      JMP TOP       GET NEXT PARAMETER
* 
* 
*  GOES IN MAIN PARM BUF
* 
* 
MAIN  CLA,INA 
      STA CBUF,I    SET NUMERIC FLAG INTO BUFFER
      ISZ CBUF      ADVANCE PAST FLAG WORD
      STB CBUF,I    SET CONVERTED VALUE INTO BUFER
      JMP TOP       FETCH NEXT PARAMETER
* 
* 
      SPC 10
* 
* 
*    ASCII PARAMETER
* 
* 
ASCII LDA CXBC      FETCH CURRENT BUFFER FLAG 
      CPA .17      MAIN BUFFER??
      JMP AMAIN     YEP--MOVE TO MAIN BUFFER
* 
* 
*    MOVE TO SUB PARM BUFFER
* 
      LDA SPCNT     IF SUB CNT >4 THEN
      ADA N4        CAN'T HAVE
      SSA,RSS               ASCII PARM
      JMP ERR?                SO ERROR EXIT 
* 
* 
      LDA .2        FETCH MAX # CHAR TO BE MOVED
      JMP MASC      GO DO IT
* 
* 
* 
*   MAIN BUF MOVE 
* 
AMAIN LDA .3        FLAG CODE FOR ASCII 
      STA CBUF,I    SET FLAG INTO BUFFER
      ISZ CBUF      ADVANCE PAST FLAG WORD
      LDA .6        SET A MAX OF 6
MASC  CMA,INA       CHARS FOR MOVE
      STA CCNT      SET IN COUNTER
* 
* 
      LDB WORKA     FETCH ADDRESS OF WK BUFFER
      ADB FNDCT     ADD # CHARS FOUND 
      STB STOP      SET AS STOP ADDRESS 
* 
* 
      LDB WORKA     FETCH WK BUF ADDR 
      STB TMP1      SET AS FROM ADDRES
      CLE,RSS       CLEAR BYTE FLAG AND SKIP ADDR FETCH 
* 
MNXT  LDB TMP1      FETCH FROM ADDRESS
      CPB STOP      IS THAT ALL FROM HERE 
      JMP GTBLK     YES--PAD WITH BLANKS
* 
      LDA B,I       FETCH CHAR FROM WORK FIELD
      ISZ TMP1      BUMP FROM ADDRESS 
POSN  SEZ,CME,RSS   NEED TO POS CHAR? 
      ALF,ALF       YES-SHIFT TO HIGH BYTE
      LDB CBUF,I    FETCH CURRENT RESULT WORD 
      IOR B         INCLUDE CURRENT CHAR
      STA CBUF,I    SAVE BACK INTO RESULT BUFFER
      SEZ,RSS       INCREMENT RESULT BUFFER ADDR
      ISZ CBUF      ONLY IF NEW WORD IS NEEDED
      ISZ CCNT      BUMP MOVE COUNT-DONE? 
      JMP MNXT      NOPE-GO SEE ABOUT NEXT CHAR 
      JMP TOP       ALL DONE--GET NEXT PARAMETER
* 
* 
GTBLK LDA B40       FETCH ASCII LOW " " 
      JMP POSN      GO PAD FIELD
* 
* 
* 
      SPC 5 
* 
NONE  LDB DNFLG     FETCH DONE FLAG 
      SSB,RSS       IF SIGN NOT SET 
      JMP PARS,I    DONE
* 
      JMP TOP       ELSE GET NEXT PARAMETER(O=NULL   )
* 
* 
* 
* 
GTCHR NOP 
* 
* 
NOBK  LDA IBP       FETCH INPUT CHAR ADDRESS
      ISZ DNFLG     BUMP CHAR COUNTER   SKIP IF DONE
      RSS           SKIP EXIT 
      JMP GTCHR,I   DONE EXIT 
      CLE,ERA       GET WORD ADDR AND SET BYTE FLAG 
      LDA A,I        FETCH INPUT WORD 
      SEZ,RSS       POSITION FOR REQUESTED BYTE 
      ALF,ALF        IF NEEDED
      AND B377       ISOLATE IT 
      ISZ IBP       BUMP CHAR ADDRESS 
      CPA B40       IF BLANK
      JMP NOBK         GET NEXT ONE 
      ISZ GTCHR      ELSE BUMP RETURN ADDRESS 
      JMP GTCHR,I    RETURN 
* 
* 
********************************************
*******THE FOLLOWING SECTION IS ZEROED******
*******EACH TIME THE PARSE ROUTINE IS ******
*******INVOKED******************************
* 
* 
*  DON'T REMOVE ANY OF THESE AS LIST
*    USES THIS SECTION AS A BUFFER
* 
* 
************
MRSLT BSS 4         FIRST 4 ARE FOR THE COMMAND 
P.RAM BSS 64        MRSLT AND P.RAM FORM THE RESULT FIELD 
************
WORK  BSS 8         TEMP BUFFER FOR CONVERSION
SPBUF BSS 10        RESULT FIELD FOR SUB PARMS
P.CNT NOP 
FNDCT NOP 
SPCNT NOP 
********************************************************* 
********************************************************* 
NXBC  NOP 
CXBC  NOP 
NXBUF NOP 
N.OPL EQU SPBUF 
CBUF  NOP 
TMP1  NOP 
TMP2  NOP 
WORKA DEF WORK
C.BUF BSS 40
CAM.A DBL C.BUF 
IBP   NOP 
MADDR DEF MRSLT 
SPADR DEF SPBUF 
DASH  OCT 55
AS.B  OCT 102 
DM58  DEC -58 
ECH   NOP 
* 
INT.  NOP 
CLN   OCT 72
CMA   OCT 54
DNFLG NOP 
N4    OCT -4
B40   OCT 40
B377  OCT 377 
* 
* 
* 
* 
* 
PLUS  OCT 53        ASCII + 
BASE  NOP 
STOP  NOP 
VALUE NOP 
CCNT  NOP 
* 
* 
LODCB BSS 144       PUT THIS HERE TO PREVENT BP LINKS 
A     EQU 0 
B     EQU 1 
LEN EQU * 
* 
      END FMGR
                                                                                                                                                                                                                    