.         EMBED Command Process
.         This element processes the EMBED command, which allows a file to be
.         stored as an element in a program file, and subsequently
.         reconstructed as a file.
.         (C)  Copyright 1972-1978  John Walker
.         This software is in the public domain
          pure      code
.         The following tag defines the 'compatibility level' of this version
.         of the EMBED command.  This level will be changed whenever a
.         nontransparent change is made to the EMBED element format.  This
.         will prevent undetected errors due to incompatible FANG
.         versions being used.
emformat  equ       1                   compatibility level
.         Commonly used registers
sn        equ       r9                  expected sequence number
e1        equ       r10                 first element class
e2        equ       r11                 second element class
f1        equ       r12                 first file FDT
f2        equ       r13                 second file FDT
ct        equ       r14                 user-supplied count
.         EMBED work buffer format
ewio      equf      0                   I/O packet to read/write program file
ewacwt    equf      6                   ACW table for scatter/gather
ewpsect   equf      8                   start of header sector block
ewl       equf      28+9                length of work buffer
.         EMBED header sector format  (within work buffer)
csent     equf      ewpsect             'EMBED$'
cid       equf      ewpsect+1           two word processor ID
ccksum    equf      ewpsect+3           checksum of data in block
csector   equf      ewpsect+4           source address in original file
cblen     equf      ewpsect+5,,h1       length of block following
cmpat     equf      ewpsect+5,,s4       compatibility level
cefb      equf      ewpsect+5,,s5       nonzero if tape end of file block
ceof      equf      ewpsect+5,,s6       nonzero if last block
cblkno    equf      ewpsect+6           block sequence number (first is 1)
cfacit    equf      ewpsect+7           first 10 words of FITEM$ of file
.                                       that was EMBEDed
ctdate    equf      ewpsect+17          TDATE$ at time of EMBED
cmaxbl    equf      ewpsect+18          largest block in file
cfill     equf      ewpsect+19          start of filler info
cfilll    equ       (ewpsect+28)-(ewpsect+18) length of filler
.         Initial command analysis
embed*    lx        x9,cdbpc,x8         load link to parameter chain
          sx        x9,e1               save first element parameter
          lx        x9,pblink,x9        link to first file
          lr        f1,pbval,x9         load first file FDT
          lx        x9,pblink,x9        link to second element
          sx        x9,e2               save it for later use
          lx        x9,pblink,x9        link to second file
          lr        f2,pbval,x9         load second file FDT
          lx        x9,pblink,x9        link to optional number
          lr,u      ct,0377777          load infinite count
          la        a15,cdopts,x8       load command options
          tep,u     a15,option('M')     is the 'M' option on ?
          lr,u      ct,1                yes.  assume one file
          tz        x9                  was parameter supplied ?
          lr        ct,pbval,x9         yes.  load user-supplied count
.         Now we see whether the input and output specifications use
.         element selection and determine by context whether this is
.         an EMBED or EXPAND type operation.  The rules for deciding
.         are as follows:
.         First parameter   Second parameter     Action
.         ---------------   ----------------     ------
.            File               File             EMBED
.            File               Element          EMBED
.            Element            File             EXPAND
.            Element            Element          Error
          la        a0,e1               load first element parameter
          tnz       elall,a0            was selection specified ?
          j         ielt                yes.  input is an element
.         EMBED processing.
.         Since no element selection was specified on the input file, that
.         file will be embedded into the second file.  First we set up to
.         read the input file.
          la        a1,f1               load input file parameter
          lmj       a2,ioget            build I/O FCT for file
          lx,u      x10,,a0             get FCT in X10
          lxi       a0,f1               move FDT to A0
          ssc       a0,18               get fct, fdt in a0
          sa        a0,f1               save for later release
          sr        ct,iocount,x10      save the block count in the fct
          tnz       iomass,x10          is the input mass storage ?
          j         embtinp             no.  go set up tape input
          la,u      a0,1792             yes.  load track size block
          sa        a0,ioblen,x10       always read track sized blocks
          sz        iodrad,x10          and start at the file start
          la,u      a0,0377777          load infinite count
          sa        a0,iocount,x10      set number of tracks to read
          la        a0,cdopts,x8        load command options
          or,u      a0,option('R')      set the 'R' option for command
          sa        a1,cdopts,x8        mark no update of file position
.         At this point we're ready to start reading the input file.
.         We defer actually firing up input until we're verified
.         that the output file is actually a program file.  This allows
.         us to get out cleaner if there is an error.
embtinr   lx        x9,e2               load second element class
          la        a0,elfdt,x9         load FDT address for file
          la        a1,fdtype,a0        load type of output file
          tne,u     a1,fwad             is output word-addressable ?
          j         embowad             yes.  can't embed into it
          jtape     a1,embotap          can't embed onto tape
          bgetl     ftil                allocate BSP file table index
          sa        a0,a14              save for later reference
          la        a1,f2               load second file FDT
          dl        a4,fdin,a1          load internal name of file
          ds        a4,ftifn,a0         store into FTI
          rfti      .                   read in file table index
          j         embonpf             error.  probably not a program file
.         Now that we've read in the file table index, we set up
.         the embed work buffer.  This buffer contains the I/O
.         packet we use to write the output file, as well as the
.         header sector we prefix to each block written.
          bgetl     ewl                 allocate working buffer
          sa        a0,x9               save for use later
          la        a1,a14              reload file table index address
          dl        a2,fdin,a1          load internal file name
          ds        a2,ewio+iofn,a0     set file name in packet
          la        a2,ftiwl,a1         load next write location in file
          sa        a2,ewio+iodrad,a0   set address to start text
          sz        iostatus,a0         clear status in packet
          la,u      a2,gw$              load gather write function
          sa        a2,iofunc,a0        set function in packet
          au        a0,(2,ewacwt)       form access word table pointer
          sa        a1,ewio+ioacw,a0    set access word table pointer
          au        a0,(28,ewpsect)     form pointer to prefix sector
          sa        a1,ewacwt,a0        set to write before data
.         Now we build the skeleton header (prefix) sector
          la        a1,('EMBED$')       load sentinel for prefix sector
          sa        a1,csent,a0         store sentinel in prefix
          la        a1,('FANG  ')       load identification of processor
          la        a2,(ljsf$1 level)   load FANG level
          ds        a1,cid,a0           set identification in sector
          la,u      a1,emformat         load compatibility level identifier
          sa        a1,cmpat,a0         store in sector
.         Copy the FITEM$ information from the source file into the
.         prefix sector.
          la        a2,f1               load first file FDT
          lxi,u     a2,1                set increment to copy data
          au        a0,(1,cfacit)       get pointer to packet in header
          lr,u      r1,10               load length to move
          bt        a1,,*a2             copy FITEM$ information
          tdate$    .                   get date and time of embed
          sa        a0,,*a1             store into header
          la,u      a2,('>FANG<')       get fill for fang sectors
          lr,u      r1,cfilll           load length of filler
          bt        a1,,*a2             fill sector with constant data
          sz        cblkno,x9           zero block sequence number
          sz        ceof,x9             mark this not last block
          la        a1,ioblen,x10       load I/O block length
          sa        a1,cmaxbl,x9        set largest block read
.         Fire up input on source file
          la        a0,f1               load input file FCT, FDT
          ssl       a0,18               right justify it in a0
          sa        a0,x10              save in X10 for the duration
          lmj       a2,input            start up input reader
.         Read buffers from the input file and set them up to be
.         written to embed element with a gather write.
embnext   get       iobb,x10            remove next block from input file
          tz        ibstat,a1           normal data block ?
          j         embabn              no.  handle abnormal block
          la,u      a2,ibdata,a1        load address of data in block
          lxi       a2,iblen,a1         load length of data
          sa        a2,ewacwt+1,x9      store in data part of ACW table
          la        a0,ibmsad,a1        load address block read from
          sa        a0,csector,x9       set into the prefix block
          sz        cefb,x9             mark this not tape mark
          ssl       a2,18               right justify the block length
          sa        a2,cblen,x9         store length in header sector
          la        a0,cblkno,x9        load block number
          aa,u      a0,1                increment block number
          sa        a0,cblkno,x9        update in sector
.         Now checksum the data read from the file
          la,u      a2,ibdata,a1        load start of data in buffer
          aa        a2,(1,0)            form pointer to scan data
          lr        r1,iblen,a1         load length of data
          la,u      a3,0                clear the checksum accumulator
          j         embcksme            enter checksum code
embcksm   xor       a3,,*a2             xor this word with previous
          ssc       a4,1                shift the result
          la        a3,a4               reload the running checksum
embcksme  jgd       r1,embcksm          loop performing checksum
          sa        a3,ccksum,x9        store block checksum in header
.         Write the block to the output file
          iow$      ewio,x9             write out the block
embwstck  tz        ewio+iostatus,x9    normal status on write ?
          j         embwerr             no.  handle write error
.         Update the next write address in the file
          la        a4,ewio+ioxfer,x9   load words written to file
          dsl       a4,36               shift down before divide
          aa,u      a5,27               round up for covered divide
          di,u      a4,28               compute sectors in block
          aa        a4,ewio+iodrad,x9   add to start address
          sa        a4,ewio+iodrad,x9   replace as next write address
          la        a0,f2               load second file fdt
          sa        a4,fdiplc,a0        update running address pointer
.         Now test the last block flag in the data just written.
.         If set, we close out the embed and enter the element.
.         If not, we just go back and keep on reading.
embterm   la        a2,iblast,a1        load last block flag
          brelp     a1                  release the data block buffer
          jz        a2,embnext          continue if more data in file
.         We have processed the last block.  Close out the element.
          la,u      a0,1                load a one
          sa        a0,ceof,x9          mark this last sector in file
          sz        cblen,x9            zero length of data in block
          sz        ccksum,x9           checksum is zero for no data
          la        a0,cblkno,x9        load current block sequence
          aa,u      a0,1                increment it
          sa        a0,cblkno,x9        replace in header sector
          la        a0,ewacwt,x9        load access word for header
          sa        a0,ewio+ioacw,x9    set as only access word
          la,u      a0,w$               load write function
          sa        a0,ewio+iofunc,x9   mark this as normal write
          iow$      ewio,x9             write the trailer block to file
          tz        ewio+iostatus,x9    normal status on write ?
          j         embwerr1            no.  edit error message
.         Element text is now complete in the file.  Construct the element
.         item and enter it in the table of contents.
          la        a0,a14              load the file table index
          la,u      a0,ftiet,a0         point to element table
          lmj       x11,pftlen          compute size of table
          aa,u      a0,eil              add room for one more element
          tg,u      a0,bufeltt+1        does it exceed maximum ?
          la,u      a0,bufeltt          yes.  restrict to maximum table
          sa        a0,a1               save length for read of table
          aa,u      a0,eil              include space for our new element
          bgetl     .                   allocate the element table
          sa        a0,a13              save for later use
          lxi,u     a1,eil,a0           load address of table start
          la        a0,a14              load fti address
          rpfet     .                   read in element table
          j         embonpf             error.  edit message
          la        a0,a13              reload element item address
          la        a1,e2               load output element class
          la        a2,f1               load input file FDT
          dl        a4,fdfn,a2          load input file name as element
          ds        a4,eien,a0          set as default element name
          dl        a4,(ljsf$2 ' ')     load spaces for version
          ds        a4,eiver,a0         set default version of spaces
          sz        eiprea,a0           clear unused word
          sz        eiprel,a0           clear unused half word
          la        a4,ewio+iodrad,x9   load last sector written address
          aa,u      a4,1                increment for length computation
          la        a2,a14              reload file table index address
          anu       a4,ftiwl,a2         compute length of element
          la        a3,ftiwl,a2         load start address of element
          sa        a4,ftiwl,a2         update next write address
          sa        a5,eitxtl,a0        set element length in item
          sa        a3,eitxta,a0        set element start address in item
          la        a3,ctdate,x9        load time of embed
          ssc       a3,18               reverse for silly item format
          sa        a3,eitime,a0        store in element creation time
          sz        eiplnk,a0           clear links
          sz        eivlnk,a0           in the item
          sz        eiflgw,a0           clear element flag bits
          la,u      a3,ty$omn           load omnibus element type
          sa        a3,eityp,a0         set element type in item
          la,u      a3,embstyp          load embed subtype
          sa        a3,eipcod,a0        set as processor code for element
          lmj       x11,rename          rename by second specification
          la        a1,a13              load item address
          la        a0,a14              load file table index address
          etia      .                   add element to file
          j         embonpf             bsp error.  print message
          la        a0,a14              reload fti address
          wpfet     .                   write back updated element table
          j         embonpf             error.  print message
          la        a0,a14              reload fti address
          wfti      .                   write file table index back
          j         embonpf             error.  print message
.         All done with processing.  Release storage and exit
embout    la        a0,f1               load source file FDT
          ssl       a0,18               right justify the FCT
          brelp     a0                  release the FCT
          brela     .                   release all the other buffers
          complete  .                   that's all for the command
.         Abnormal status in block from input file.  Handle depending
.         upon the actual status received and the file type.
embabn    la        a0,ibstat,a1        load status from block
          tne,u     a0,sterm            software termination ?
          j         embterm             yes.  this is end indicator
          te,u      a0,1                is it end of file ?
          j         embrerr             no.  read error from file
          tz        iomass,x10          yes.  is input really a tape ?
          j         embterm             no.  ignore end of file from mass
.         End of file mark read from tape.  Write end of file sector
.         to allow us to reproduce the mark on the output.
          sz        ccksum,x9           clear the checksum word
          sz        cblen,x9            clear the block length
          sz        csector,x9          mark no source address
          sa        a0,cefb,x9          set a one in end of file block flag
          la        a0,cblkno,x9        load block sequence number
          aa,u      a0,1                increment it by one
          sa        a0,cblkno,x9        replace in header sector
          la        a4,ewio+ioacw,x9    save the access word table pointer
          la        a0,ewacwt,x9        load the access word for header
          sa        a0,ewio+ioacw,x9    store into access word in packet
          la,u      a0,w$               load write function
          sa        a0,ewio+iofunc,x9   turn into simple write
          iow$      ewio,x9             write end of file block
          la,u      a0,gw$              load gather write function
          sa        a0,ewio+iofunc,x9   replace in packet
          sa        a4,ewio+ioacw,x9    replace access word table pointer
          j         embwstck            go check status on write and continue
.         Write error on output program file.  Release output buffer
.         and edit an error message.
embwerr   la        a2,iblast,a1        load the last block flag
          brelp     a1                  release the block buffer
          sr        f2,iofdt,x9         save the fdt for message editing
          la,u      a0,ewio,x9          load I/O FCT address
          lmj       x11,iosedt          edit the error message
          jz        a2,embrerr1         sink data if not last block
          j         embout              otherwise, just exit
.         Write error closing the element
embwerr1  sr        f2,iofdt,x9         set fdt link for error message
          lmj       x11,iosedt          edit error message for I/O
          j         embout              go terminate the command
.         Real error status encountered.  Terminate command and quit.
embrerr   la        a2,iblast,a1        load last block flag
          brelp     a1                  release the block buffer
          jnz       a2,embout           terminate if last block
embrerr1  snonz     cdcease,x8          mark command in termination
          lmj       a2,iognf            get a dummy fct
          sa        a0,x9               save it in x9
          lmj       a2,sink             discard the input buffers
          p         iobb+ql,x9          wait for sink to complete
          brelp     x9                  release sink fct
          j         embout              go terminate the command
.         Tape input to EMBED.  Set up the read modes
embtinp   la,u      a0,'M'              load 'M' I/O option
          tep,u     a15,option('M')     was the 'M' option on the command ?
          sa        a0,ioopt,x10        set option in FCT
          j         embtinr             continue with the command
.         Error.  Output file is word-addressable.
embowad   r$dit     .                   fire up the editor
          e$msg1    embfterm            copy bad file error message
          e$msg1    emwadm              say word-addressability was bad
embofter  la        a0,f2               load output file FDT
          lmj       x11,fist            edit file and statement
          zap       .                   error the command
          brelp     x10                 release the I/O FCT
          complete  .                   terminate the command
.         Output file was a tape
embotap   r$dit     .                   fire up the editor
          e$msg1    embfterm            copy the common message
          e$msg1    emtapm              say that tape is a 'no no'
          j         embofter            go edit file type message
.         BSP error on output file
embonpf   la        a2,a14              load the FTI address
          lmj       x11,bsperp          print the error message
          j         embout              terminate the command
          pure      data
embfterm  'Cannot EMBED into &'
emwadm    'word-addressable &'
emtapm    'tape &'
          pure      code
.         Expansion of EMBEDed element back into file
ielt      la        a1,e2               load output element specification
          tnz       elall,a1            is the output a file ?
          j         bothelt             no.  error, both are elements
          lx        x9,e1               load input element specification
          la,u      a7,0                set to select only undeleted elements
          lmj       x11,filescan        select elements from the file
          j         exbsper             error.  bsp error
          lmj       x11,eltrel          release the element table buffer
          jz        a8,expempty         skip if no elements selected
          tep       a15,(option('A'))   alphabetise before selecting ?
          lmj       x11,filesort        yes.  that's what we advertised !!
.         Now go through the elements selected and look for an Omnibus
.         with EMBED subtype.  We will pick the first such element we
.         find.
expelts   remove    cdeltq,x8           remove next selected element
          tne,u     a1,cdeltq,x8        end of queue and no find ?
          j         expempty            yes.  print 'no element selected'
          ana,u     a1,eifq             back up to head of item
          lx,u      x7,,a1              save current element in X7
          la        a0,eityp,x7         load major type of element
          la        a1,eipcod,x7        load processor code (subtype)
          tne,u     a0,ty$omn           is it Omnibus ?
          te,u      a1,embstyp          yes.  is is EMBED-created ?
          j         expskip             no.  don't select it
          j         expfelt             yes.  we've found an element
expskip   brelr     x7                  release this item
          j         expelts             keep on looking
.         We've found an element to expand.  Set up work buffer to read its
.         text.
expfelt   bgetl     ewl                 allocate work buffer
          sa        a0,a12              save its address
          sa        a0,x6               save for later use
          la        a1,a14              load file table index address
          dl        a2,ftifn,a1         load file name of input
          ds        a2,ewio+iofn,a0     set name in work buffer packet
          la        a2,eitxta,x7        load start address of text
          sa        a2,ewio+iodrad,a0   set address to start reading
          sz        ewio+iostatus,a0    clear status so not busy
          la,u      a2,r$               load normal read function
          sa        a2,ewio+iofunc,a0   set function in packet
          au        a0,(28,ewpsect)     load the pointer to the sector
          sa        a1,ewio+ioacw,a0    set access word in packet
          sa        a1,ewacwt,a0        put in access word table also
          lmj       x11,readembe        read in header and check status
          j         exprerp             error reading first prefix
          la        a0,csent,x6         load sentinel from block
          te        a0,('EMBED$')       is this a valid header ?
          j         expnote             no.  not an EMBED element
          sz        sn                  clear expected sequence number
          la        a1,f2               load output file FDT
          lmj       a2,ioget            build FCT to write output file
          lx        x9,a0               save the FCT address in X9
          lxi       a0,f2               load address of FDT
          ssc       a0,18               shift FDT back to low half
          sa        a0,f2               save output fct, fdt
.         Now build the pseudo-input FCT used to pass blocks to the
.         output file.  Note that this FCT must be initialised with the
.         properties of the original EMBEDed file so that address
.         translation for WAD files will operate correctly.
          lmj       a2,iognf            build dummy FCT
          lx        x10,a0              save its address in X10
          la        a0,cfacit+fdeqt,x6  load equipment type of original file
          la        a0,eqttab,a0        load equipment type table entry
          tep,u     a0,epmass           mass storage type ?
          snonz     iomass,x10          yes.  mark this mass storage
          tep,u     a0,epwad            is it word-addressable ?
          snonz     iowad,x10           yes.  mark it word-addressable
          tz        iomass,x10          was input mass storage ?
          tnz       iomass,x9           yes.  was output ?
          j         expotp              no.  check for tape involvement
          la,u      a0,'D'              yes.  load duplicate addresses mode
expsiop   sa        a0,ioopt,x9         set mode of output process
          lmj       a2,output           fire up the output process
.         Now that we're all initialised, we set up to do the scatter
.         reads we'll actually use to read the text.
          la,u      a0,,x6              load the work buffer address
          aa        a0,(2,ewacwt)       form access word table pointer
          sa        a0,ewio+ioacw,x6    set in access word in packet
          la,u      a0,scr$             load scatter read function
          sa        a0,ewio+iofunc,x6   change to scatter read text
          la        a0,cmaxbl,x6        load maximum length of blocks in file
          sa,h1     a0,ewacwt+1,x6      plug in length of data access word
.         If the 'T' option is on the command, edit a message describing
.         the original source of the file being expanded.
          top,u     a15,option('T')     does user want file origin info ?
          j         exprnext            no.  go start loading data
          r$dit     .                   fire up the editor
          e$msg     loading             edit the file load message
          lx,u      x5,cfacit,x6        load packet describing input file
          e$fd2     fdqual,x5           edit file qualifier
          e$char    '*'                 edit asterisk before name
          e$fd2     fdfn,x5             edit file name
          la,h2     a3,6,x5             load the F-CYCLE word
          and,u     a3,07777            isolate the absolute cycle
          tz        a4                  temporary file ?
          tne,u     a4,1                no.  is it cycle one ?
          j         exptcyc1            yes.  Don't edit it
          e$char    '('                 edit open parenthesis
          e$decv    a4                  edit the f-cycle
          e$char    ')'                 edit closing parenthesis
exptcyc1  e$msgr    .                   copy to element being loaded
          sx        x9,ct               save output file FCT
          lx        x9,x7               load current element item
          lmj       x6,edena            edit element name being expanded
          e$msgr    .                   copy to file containing element
          la        a0,f1               load FDT of input file
          lmj       x11,fist            append file and statement
          lx        x9,ct               restore output file FCT
          lx        x6,a12              restore the work buffer
          j         exprnext            go read the first data block
.         Now we process the data from the element.  As we tear the
.         blocks apart, they are queued to the output process.
expnext   la        a0,sn               load sequence number
          aa,u      a0,1                increment it
          sa        a0,sn               update sequence number
          te        a0,cblkno,x6        is this the expected block ?
          j         expseqer            no.  print sequence error message
.         See if entire block was read O.K.
          la        a0,ewio+ioxfer,x6   load I/O words transferred count
          ana,u     a0,28               back off prefix block length
          tle       a0,cblen,x6         was entire block read ?
          j         expincb             no.  error in file
.         This is a normal data block.  Checksum the data and compare
.         against checksum saved in file.
          lr        r1,cblen,x6         load length of data
          la,h2     a2,ewacwt+1,x6      load data block start
          aa        a2,(1,0)            get pointer to scan data
          la,u      a0,0                clear the checksum
          j         expcksme            enter the checksum loop
expcksm   xor       a0,,*a2             xor new word with running ckecksum
          ssc       a1,1                shift circularly
          la        a0,a1               move down into running total
expcksme  jgd       r1,expcksm          loop for all words
          te        a0,ccksum,x6        is the ckecksum correct ?
          j         expcksmb            no.  invalid checksum on block
.         Data is good.  Form the block header.
          la,h2     a1,ewacwt+1,x6      load address of data block
          ana,u     a1,ibdata           back up to block header
          la,u      a0,0                load normal status
          tz        cefb,x6             was this a tape end of file mark ?
          la,u      a0,1                yes.  set end of file status
          sa        a0,ibstat,a1        set status into block buffer
          sz        iblast,a1           mark this not the last block
          sz        ibafc,a1            clear abnormal frame count
          sx        x6,ibiop,a1         set back pointer to I/O FCT
          la        a0,csector,x6       load sector address of source
          sa        a0,ibmsad,a1        set into address of block
          la        a0,cblen,x6         load length of block
          jz        a0,expzerb          skip if no data in block
          sa        a0,iblen,a1         set length in block buffer
          put       iobb,x10            pass block to output process
          lx        x6,a12              reload embed work buffer address
.         Update the next read address in the input file
expzerr   la        a0,cblen,x6         load length of block read
          dsl       a0,36               shift into double word quantity
          aa,u      a1,28+27            add header sector and round up
          di,u      a0,28               compute sectors in this block
          aa        a0,ewio+iodrad,x6   add to running address
          sa        a0,ewio+iodrad,x6   replace in the I/O packet
          la        a1,f1               load input file FDT
          sa        a0,fdiplc,a1        update running address pointer
.         If the block just processed is the last, go to closeout code.
.         Otherwise, read the next text block and continue.
          tz        ceof,x6             do more blocks follow ?
          j         expdone             no.  all done with element
exprnext  la        a0,cmaxbl,x6        load maximum block size
          aa,u      a0,ibdata           add data block header length
          bget      .                   allocate block buffer
          aa,u      a0,ibdata           advance to data in buffer
          sa,h2     a0,ewacwt+1,x6      set buffer address in ACW table
          lmj       x11,readembe        read text from file
          j         exprer              error.  terminate expansion
          la        a0,csent,x6         load sentinel from block
          tne       a0,('EMBED$')       is this an embed block ?
          j         expnext             yes.  continue processing file
          j         expbsent            no.  bad sentinel
.         Release the data buffer when zero length block read
expzerb   brelp     a1                  release the block buffer
          j         expzerr             continue processing normally
.         All data has been sent.  Place a termination buffer on the
.         output queue and run down output.
expdone   bget      ibdata              allocate termination buffer
          la        a1,a0               copy address of buffer
          la,u      a0,sterm            load software termination status
          sa        a0,ibstat,a1        set status in buffer
          snonz     iblast,a1           flag thid as the last buffer
          put       iobb,x10            place on output queue to terminate
          p         iobb+ql,x9          wait for output to complete
          brelp     x9                  release the output FCT
          brelp     x10                 release the input FCT
expout1   brela     .                   release all other storage
          complete  .                   complete the command
.         Set up tape output
expotp    la,u      a0,'M'              load 'M' I/O option
          j         expsiop             go set up I/O option
.         Read data from program file and check status
.         This routine permits an 05 or 022 status so long as at
.         at least 28 words are transferred.  This allows us to
.         read ahead the maximum block length without errorring
.         when we pass the actual end of the file.
readembe  iow$      ewio,x6             read a block of data
          tnz       ewio+iostatus,x6    normal completion on read ?
          j         1,x11               yes.  return to caller
          la        a0,ewio+iostatus,x6 load the I/O status
          te,u      a0,5                was it end of data ?
          tne,u     a0,022              no.  How about end of file ?
          j         $+2                 yes.  check transfer count
          j         0,x11               no.  return to error exit
          la        a0,ewio+ioxfer,x6   load the words transferred
          tg,u      a0,28               is it at least one sector ?
          j         1,x11               yes.  consider it normal
          j         0,x11               no.  ran out of data
.         Error.  Both specficiations specify elements.
bothelt   r$dit     .                   fire up the editor
          e$msg     bothem              copy the error message
          lmj       x11,ist             append the statement number
          zap       .                   error the command
          complete  .                   complete the command
.         BSP error scanning file
exbsper   la        a2,a14              load FTI address
          lmj       x11,bsperp          edit the BSP error message
          zap       .                   error the command
          j         expout1             return to complete command
.         Bad sentinel in first block
expnote   r$dit     .                   fire up the editor
          lx        x9,x7               load the element item
          lmj       x6,edena            edit element name
          e$msg     expnotm             edit the not embed error message
          lmj       x11,ist             append statement number
expribe   zap       .                   error the command
          j         expout1             go complete the command
.         Bad sentinel while loading file
expbsent  r$dit     .                   fire up the editor
          e$msg     expbsen             copy the error message
          sx        x9,ct               save the I/O FCT address
          e$fd1     csent,x6            edit the current sentinel
          e$msgr    .                   copy to element name
expeden   lx        x9,x7               load current element item
          lmj       x6,edena            edit the element name
          lx        x9,ct               restore I/O FCT address
          e$msgr    .                   copy to file and statement
          la        a0,f1               load input file FDT
          lmj       x11,fist            append file and statement
exprout   lx        x6,a12              restore work buffer address
          la,h2     a0,ewacwt+1,x6      load the I/O buffer address
          ana,u     a0,ibdata           back up to start of buffer
          brelp     a0                  release the I/O buffer
          zap       .                   error the command
          j         expdone             go terminate the command
.         Sequence error
expseqer  r$dit     .                   fire up the editor
          e$msg     expbseq             copy the error message
expdatar  sx        x9,ct               save the I/O FCT address
          j         expeden             go edit the element name
.         Checksum error
expcksmb  r$dit     .                   fire up the editor
          e$msg     expcksmm            copy the error message
          j         expdatar            go to common data error code
.         No element selected
expempty  r$dit     .                   fire up the editor
          e$msg     noesem              copy the error message
          la        a0,f1               load FDT for input file
          lmj       x11,fist            append the file and statement
          zap       .                   error the command
          j         expout1             get out of the command
.         Incomplete block read from file
expincb   r$dit     .                   fire up the editor
          e$msg     expincm             copy the incomplete message
          j         expdatar            go to common data error code
.         Error reading file preamble
exprerp   sr        f1,iofdt,x6         set the FDT pointer in the I/O FCT
          la,u      a0,ewio,x6          load the I/O packet addresss
          lmj       x11,iosedt          edit the I/O status
          j         expribe             go to common error code
.         Error reading text of file
exprer    sr        f1,iofdt,x6         save the FDT pointer in I/O FCT
          la,u      a0,ewio,x6          load the I/O packet address
          lmj       x11,iosedt          edit the I/O status
          j         exprout             go finish the command
          pure      data
loading   'Restoring ! from element ! of !'
bothem    'Both specifications are elements.  Cannot EMBED !'
expnotm   ' is not am EMBEDed file !'
expbsen   'Bad sentinel ''!'' in ! of !'
expbseq   'Sequence error in ! of !'
expcksmm  'Checksum error in ! of !'
noesem    'No element selected from !'
expincm   'Incomplete data block in ! of !'