$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_UNPACK_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 8.2
$!   On  5-FEB-1993 14:28:07.91   By user GOATHUNTER (@WKUVX1.BITNET)
$!
$! The VMS_SHARE software that created this archive
$!    was written by  Andy Harper, Kings College London UK
$!    -- December 1992
$!
$! Credit is due to these people for their original ideas:
$!    James Gray, Michael Bednarek
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. CALRMS.DESC;1
$!       2. COPY.C;1
$!       3. COPY_FILE.MAR;1
$!       4. RMS.TXT;1
$!       5. TYPE.MAR;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_UNPACK_TEMP","SYS$SCRATCH:."+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if .not. f$trnlnm("SHARE_UNPACK_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto start
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$unpack: subroutine ! P1=filename, P2=checksum, P3=attributes
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'"
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn' File skipped"
$ delete 'f'*
$ exit
$dirok:
$ x=f$search(P1)
$ if x .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped"
$ delete 'f'*
$ exit
$file_absent:
$ w "-I-UNPACK, Unpacking file ", P1
$ n=P1
$ if P3 .nes. "" then $ n=f
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='n'
PROCEDURE GetHex(s,p)LOCAL x1,x2;x1:=INDEX(t,SUBSTR(s,p,1))-1;x2:=INDEX(t,
SUBSTR(s,p+1,1))-1;RETURN 16*x1+x2;ENDPROCEDURE;
PROCEDURE SkipPartsep LOOP EXITIF MARK(NONE)=END_OF(b);EXITIF INDEX(ERASE_LINE,
"-+-+-+-+-+-+-+-+")=1;ENDLOOP;ENDPROCEDURE;PROCEDURE ProcessLine LOCAL c,s,l,b,
n,p;c := ERASE_CHARACTER(1);s := ERASE_LINE;IF c = "X" THEN SPLIT_LINE; ENDIF;
MOVE_HORIZONTAL(-1);l := LENGTH(s);p := 1;LOOP EXITIF p > l;c := SUBSTR(s,p,1);
p := p+1;CASE c FROM ' ' TO '`' ['`']: COPY_TEXT(ASCII(GetHex(s,p))); p:=p+2;[
' ']: p:=p+1;[INRANGE,OUTRANGE]: COPY_TEXT(c);ENDCASE;ENDLOOP;ENDPROCEDURE;
PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE)=END_OF(b);
IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;ELSE ProcessLine;
MOVE_HORIZONTAL(1);ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=GET_INFO(
COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,GET_INFO(
COMMAND_LINE,"output_file"));QUIT;
$ if p3 .eqs. "" then $ goto dl
$ open/write fdl &f
$ write fdl "RECORD"
$ write fdl P3
$ close fdl
$ w "-I-CONVRFM, Converting record format to ", P3
$ convert/fdl=&f &f-1 &P1
$dl: delete 'f'*
$ checksum 'P1'
$ if checksum$checksum .nes. P2 then $ -
  e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ exit
$ endsubroutine
$start:
$!
$ create 'f'
XThis`20file`20features`20code`20previously`20published`20in`20the`20January/Fe
Vbruary`201993`20
Xissue`20of`20Digital`20Systems`20Journal.`20Originally`20run`20as`20part`20of
V`20Hunter`20
XGoatley's`20article`20"MACRO`20Made`20Easy:`20Readin',`20Writin',`20and`20MACR
VO,"`20which`20
Xran`20on`20page`2032,`20the`20routines`20provide`20a`20look`20at`20doing`20fil
Ve`20I/O`20from`20MACRO`20
Xusing`20RMS.
$ call unpack CALRMS.DESC;1 1415448141 ""
$!
$ create 'f'
X/*
X`20*`20`20File:`09COPY.C
X`20*
X`20*`20`20Author:`09Hunter`20Goatley,`20goathunter@WKUVX1.BITNET
X`20*
X`20*`20`20Date:`09November`2015,`201992
X`20*
X`20*`20`20Abstract:
X`20*
X`20*`09Incredibly`20simplistic`20C`20program`20that`20copies`20one`20file`20to
V`20another
X`20*`09by`20calling`20the`20MACRO-32`20routine`20COPY_FILE.
X`20*
X`20*/
X#include`20<descrip.h>
X
Xextern`20COPY_FILE();
X
Xint`20main(int`20argc,`20char`20*argv`5B`5D)
X`7B
X`20`20`20struct`20dsc$descriptor_s`20infile`20`20=`20`7B0,`20DSC$K_DTYPE_T,
V`20DSC$K_CLASS_S,`200`7D;
X`20`20`20struct`20dsc$descriptor_s`20outfile`20=`20`7B0,`20DSC$K_DTYPE_T,`20DS
VC$K_CLASS_S,`200`7D;
X
X`20`20`20if`20(argc`20!=`203)`20`7B`09`09`09/*`20Simple`20error`20check`20*/
X`20`20`20`20`20`20printf("Usage:`20copy`20old-file`20new-file`5Cn");
X`20`20`20`20`20`20return(1);
X`20`20`20`7D
X
X`20`20`20/*`20`20Initialize`20the`20string`20descriptors`20using`20the`20(expe
Vcted)`20arguments`20`20*/
X`20`20`20infile.dsc$w_length`20=`20strlen(argv`5B1`5D);
X`20`20`20infile.dsc$a_pointer`20=`20argv`5B1`5D;
X
X`20`20`20outfile.dsc$w_length`20=`20strlen(argv`5B2`5D);
X`20`20`20outfile.dsc$a_pointer`20=`20argv`5B2`5D;
X
X`20`20`20/*`20`20Now`20copy`20the`20file`20`20*/
X`20`20`20return`20(COPY_FILE`20(`26infile,`20`26outfile));
X`7D
$ call unpack COPY.C;1 305995664 ""
$!
$ create 'f'
X`09.TITLE`09COPY_FILE
X`09.IDENT`09/01-000/
X;++
X;
X;`20`20Facility:`09COPY_FILE
X;
X;`20`20Author:`09Hunter`20Goatley
X;`09`09goathunter@WKUVX1.BITNET
X;`09`09Western`20Kentucky`20University
X;
X;`20`20Date:`09November`2015,`201992
X;
X;`20`20Abstract:
X;
X;`09This`20MACRO-32`20module`20contains`20the`20routine`20COPY_FILE.`20`20It
V`20is
X;`09provided`20as`20an`20example`20of`20calling`20RMS`20routines`20from`20MACR
VO-32
X;`09for`20the`20"MACRO`20Made`20Easy"`20series`20in`20_Digital`20Systems`20Jou
Vrnal_.
X;
X;`20`20Modified`20by:
X;
X;`0901-000`09`09Hunter`20Goatley`09`0915-NOV-1992`2015:48
X;`09`09Original`20version.
X;
X;--
X`09.DSABL`09GLOBAL`09`09`09`09;`20Declare`20external`20references
X`09.ENABL`09SUPPRESSION`09`09`09;`20Don't`20list`20unreference`20symbols
X`09.NOSHOW`09BINARY`09`09`09`09;`20Include`20binary`20in`20listings
X
X`09.MACRO`09ON_ERR`09THERE,?HERE
X`09BLBS`09R0,HERE`09`09`09`09;`20Branch`20on`20success
X`09BRW`09THERE`09`09`09`09;`20Branch`20to`20THERE`20on`20error
X`20HERE:`09.ENDM`09ON_ERR
X
X`09$DSCDEF`09`09`09`09`09;`20Descriptor`20symbols
X`09$RMSDEF`09`09`09`09`09;`20RMS`20status`20symbols
X`09$FABDEF`09`09`09`09`09;`20Define`20FAB`20symbols
X`09$RABDEF`09`09`09`09`09;`20Define`20RAB`20symbols
X`09$SSDEF`09`09`09`09`09;`20System`20service`20status`20symbols
X
XMAX_REC_SIZE`20=`20127*512`09`09`09`09;`20Read`20up`20to`20127`20blocks`20at
V`20once
X
X`09.SHOW`09BINARY`09`09`09`09;`20Include`20binary`20in`20listings
X
X`0C
X`09.PSECT`09_COPY_FILE_DATA,NOEXE,WRT,LONG
X;
X;***`20`20File`20Access`20Block`20for`20input
X;
XINFAB:`09`09$FAB`09FAC=<BIO,GET>,-`09`09;`20File`20Access`20(Block`20I/O`20
V`26`20GET)
X`09`09`09SHR=<GET>`09`09;`20Allow`20others`20to`20read`20also
X;
X;***`20`20Record`20Access`20Block`20for`20input
X;
XINRAB:`09`09$RAB`20`20`20`20FAB=INFAB,`20-`09`09;`20The`20File`20Access`20Bloc
Vk
X`09`09`09RAC=SEQ,`20-`09`09;`20Record`20Access`20is`20sequential
X`09`09`09UBF=INREC,`20-`09`09;`20Input`20buffer`20address
X`09`09`09USZ=MAX_REC_SIZE`09;`20The`20max`20size`20of`20record
X;
X;***`20`20File`20Access`20Block`20for`20output
X;
XOUTFAB:`09`09$FAB`09FAC=<BIO,PUT>`09`09;`20File`20Access`20(Block`20I/O`20`26
V`20PUT)
X;
X;***`20`20Record`20Access`20Block`20for`20output
X;
XOUTRAB:`09`09$RAB`20`20`20`20FAB=OUTFAB,`20-`09`09;`20The`20File`20Access`20Bl
Vock
X`09`09`09RAC=SEQ,`20-`09`09;`20Record`20Access`20is`20sequential
X`09`09`09RBF=INREC`09`09;`20The`20record`20buffer`20address
X
X`09`09.ALIGN`09LONG
XINREC:`09`09.BLKB`09MAX_REC_SIZE`09`09;`20Input`20buffer
X
X`0C
X`09.SBTTL`09COPY_FILE
X;+
X;
X;`20`20Routine:`09COPY_FILE
X;
X;`20`20Functional`20Description:
X;
X;`09This`20routine`20copies`20one`20file`20to`20another`20using`20RMS`20block
V`20I/O.
X;`09The`20data`20in`20the`20file`20is`20copied`20intact,`20though`20not`20all
V`20file
X;`09attributes`20are`20preserved;`20specifically,`20such`20things`20as`20creat
Vion
X;`09date,`20backup`20date,`20protection,`20etc.,`20are`20not`20maintained.
X;
X;`09NOTE:`20THIS`20ROUTINE`20MAKES`20SOME`20ASSUMPTIONS`20ABOUT`20THE`20PARAME
VTERS
X;`09PASSED`20IN.`20`20IT`20ASSUMES`20THAT`20STRING`20DESCRIPTOR`20ADDRESSES
V`20ARE
X;`09PASSED`20BY`20REFERENCE.
X;
X;`09Also,`20note`20that`20the`20source`20file`20name`20is`20used`20as`20the
V`20default
X;`09file`20name`20of`20the`20copy.`20`20The`20new`20file`20will`20be`20created
V`20in`20the
X;`09same`20directory`20as`20the`20existing`20file.
X;
X;`20`20Formal`20parameters:
X;
X;`094(AP)`09-`20Address`20of`20descriptor`20for`20the`20source`20file
X;`098(AP)`09-`20Address`20of`20descriptor`20for`20the`20new`20file
X;
X;`20`20Returns:
X;
X;`09R0`09-`20Status
X;
X;-
X
XOLD_FILE`09=`201*4`09`09`09`09;`20The`20original`20file`20name
XNEW_FILE`09=`202*4`09`09`09`09;`20The`20filename`20of`20the`20copy
X
X`09.PSECT`09_COPY_FILE_CODE,EXE,NOWRT,LONG,SHR
X`09.ENTRY`09COPY_FILE,`5EM<R2,R3,R4,R5,R6,R7>
X
X`09MOVAB`09INFAB,R2`09`09`09;`20Move`20addresses`20to`20registers
X`09MOVAB`09OUTFAB,R3`09`09`09;`20...`20for`20efficiency
X`09MOVAB`09INRAB,R4`09`09`09;`20...
X`09MOVAB`09OUTRAB,R5`09`09`09;`20...
X;
X;`20`20Initialize`20the`20file`20name`20in`20the`20original`20file's`20FAB.
X;
X`09MOVQ`09@OLD_FILE(AP),R6`09`09;`20Get`20descriptor`20of`20file`20names
X`09MOVZBL`09R6,R6`09`09`09`09;`20Get`20the`20length`20as`20a`20byte
X`09$FAB_STORE`20-`09`09`09`09;`20Store`20the`20filename`20in`20the`20FAB
X`09`09FAB=(R2),`20-`09`09`09;`20...
X`09`09FNA=(R7),`20-`09`09`09;`20...
X`09`09FNS=R6`09`09`09`09;`20...
X;
X;`20`20Copy`20the`20name`20to`20the`20new`20file's`20FAB`20as`20the`20default
V`20name`20to`20allow
X;`20`20default`20fields`20to`20be`20applied,
X;
X`09$FAB_STORE`20-`09`09`09`09;`20Store`20the`20filename`20in`20the`20FAB
X`09`09FAB=(R3),`20-`09`09`09;`20...`20`20Use`20for`20the`20default
X`09`09DNA=(R7),`20-`09`09`09;`20...`20`20file`20spec`20for`20the`20target
X`09`09DNS=R6`09`09`09`09;`20...`20`20(for`20wildcarding)
X;
X;`20`20Now`20store`20the`20new`20filename`20in`20the`20FAB.
X;
X`09MOVQ`09@NEW_FILE(AP),R6`09`09;`20Get`20descriptor`20for`20new`20name
X`09MOVZBL`09R6,R6`09`09`09`09;`20Get`20the`20length`20as`20a`20byte
X`09$FAB_STORE`20-`09`09`09`09;`20Store`20the`20filename`20in`20the`20FAB
X`09`09FAB=(R3),`20-`09`09`09;`20...
X`09`09FNA=(R7),`20-`09`09`09;`20...
X`09`09FNS=R6`09`09`09`09;`20...
X;
X;`20`20Open`20the`20original`20file`20for`20reading.
X;
X`09$OPEN`09FAB=(R2)`09`09`09;`20Open`20the`20input`20file
X`09ON_ERR`0950$`09`09`09`09;`20Branch`20on`20error
X`09$CONNECT`20RAB=(R4)`09`09`09;`20Connect`20the`20RAB`20to`20it
X`09ON_ERR`0950$`09`09`09`09;`20Branch`20on`20error
X;
X;`20`20The`20file`20is`20open,`20so`20copy`20the`20fields`20related`20to`20org
Vanization,`20type,
X;`20`20size,`20etc.,`20to`20the`20FAB`20for`20the`20new`20file.
X;
X`09MOVL`09FAB$L_ALQ(R2),FAB$L_ALQ(R3)`09;`20Copy`20the`20Allocation`20size
X`09MOVW`09FAB$B_BKS(R2),FAB$B_BKS(R3)`09;`20Copy`20the`20bucket`20size
X`09MOVL`09FAB$L_MRN(R2),FAB$L_MRN(R3)`09;`20Copy`20the`20maximum`20record`20#
X`09MOVW`09FAB$W_MRS(R2),FAB$W_MRS(R3)`09;`20Copy`20the`20Maximum`20Record`20Si
Vze
X`09MOVB`09FAB$B_ORG(R2),FAB$B_ORG(R3)`09;`20Copy`20the`20file`20ORGanization
X`09MOVB`09FAB$B_RAT(R2),FAB$B_RAT(R3)`09;`20Copy`20the`20Record`20ATtributes
X`09MOVB`09FAB$B_RFM(R2),FAB$B_RFM(R3)`09;`20Copy`20the`20Record`20ForMat
X;
X;`20`20Now`20create`20the`20new`20file`20using`20the`20$CREATE`20service.
X;
X`20`20`20`20`20`20`09$CREATE`09FAB=(R3)`09`09`09;`20Open`20the`20same`20file
V`20for`20output
X`09ON_ERR`0950$`09`09`09`09;`20Branch`20on`20error
X
X`09PUSHL`09#SS$_NORMAL`09`09`09;`20Save`20"normal"`20status`20on`20stack
X
X`09$CONNECT`20RAB=(R5)`09`09`09;`20Connect
X`09ON_ERR`0930$`09`09`09`09;`20Branch`20on`20error
X;
X;`20`20The`20SS$_NORMAL`20is`20still`20on`20top`20of`20the`20stack`20to`20be
V`20used`20when`20EOF`20is`20reached.
X;
X;`20`20Multiple`20blocks`20are`20read`20with`20each`20$READ`20and`20written
V`20with`20each`20$WRITE.
X;
X;
X`2010$:`09$READ`09RAB=(R4)`09`09`09;`20Read`20a`20block`20of`20the`20file
X`09CMPL`09#RMS$_EOF,R0`09`09`09;`20End`20of`20file?
X`09BEQLU`0940$`09`09`09`09;`20Branch`20if`20so
X`09BLBC`09R0,30$`09`09`09`09;`20Success?`20`20Go`20on
X`2020$:`09MOVW`09RAB$W_RSZ(R4),RAB$W_RSZ(R5)`09;`20Move`20the`20size`20to`20th
Ve`20OUTRAB
X`09$WRITE`09RAB=(R5)`09`09`09;`20Write`20the`20modified`20record`20out
X`09BLBC`09R0,30$`09`09`09`09;`20Error?`20`20Return`20it
X`09BRB`0910$`09`09`09`09;`20Go`20get`20next`20record`20and`20process`20it
X`09`09`09`09`09`09;
X`2030$:`09MOVL`09R0,(SP)`09`20`20`20`09`09`09;`20Save`20the`20error`20status
X`2040$:`09$CLOSE`09FAB=(R3)`09`09`09;`20Close`20the`20file
X`09POPL`09R0`20`20`20`20`09`09`09`09;`20Restore`20the`20status
X`2050$:`09PUSHL`09R0`09`09`09`09;`20Save`20the`20status
X`09$CLOSE`09FAB=(R2)`09`09`09;`20Close`20the`20input`20file
X`09POPL`09R0`09`09`09`09;`20Restore`20the`20status
X`09RET`09`09`09`09`09;`20Return`20to`20the`20caller
X
X`09.END
$ call unpack COPY_FILE.MAR;1 976803047 ""
$!
$ create 'f'
XRecord`20Management`20Services
X
X$CLOSE`09`09Close`20a`20file
X$CONNECT`09Connect`20a`20RAB`20to`20a`20file
X$CREATE`09`09Create`20a`20file
X$DELETE`09`09Delete`20a`20record`20in`20a`20file
X$DISCONNECT`09Disconnect`20a`20RAB`20from`20a`20file
X$DISPLAY`09Get`20file`20attribute`20information
X$ENTER`09`09Enter`20a`20file`20name`20into`20a`20directory
X$ERASE`09`09Delete`20a`20file`20and`20its`20directory`20entry
X$EXTEND`09`09Extend`20a`20file's`20size`20(allocate`20more`20blocks)
X$FIND`09`09Find`20a`20particular`20record`20in`20a`20file
X$FLUSH`09`09Flush`20all`20RMS`20buffers`20to`20disk
X$FREE`09`09Unlock`20all`20locked`20records
X$GET`09`09Get`20a`20record`20from`20a`20file
X$NXTVOL`09`09Process`20next`20tape`20volume
X$OPEN`09`09Open`20a`20file
X$PARSE`09`09Parse`20a`20filename
X$PUT`09`09Write`20a`20record`20to`20a`20file
X$READ`09`09Read`20a`20block`20from`20a`20file`20(block`20I/O)
X$RELEASE`09Unlock`20the`20current`20record
X$REMOVE`09`09Remove`20a`20file's`20directory`20entry
X$RENAME`09`09Rename`20a`20file
X$REWIND`09`09Position`20file`20pointer`20to`20first`20record
X$SEARCH`09`09Search`20for`20one`20or`20more`20files
X$SPACE`09`09Move`20forward`20or`20backward`20X`20blocks
X$TRUNCATE`09Remove`20records`20from`20the`20end`20of`20a`20file
X$UPDATE`09`09Update`20a`20record`20in`20an`20indexed`20file
X$WAIT`09`09Wait`20for`20asynchronous`20RMS`20I/O
X$WRITE`09`09Write`20a`20block`20to`20a`20file`20(block`20I/O)
X
X
XStorage`20macros
X
X$FAB`09`09Define`20a`20File`20Access`20Block
X$RAB`09`09Define`20a`20Record`20Access`20Block
X$NAM`09`09Define`20a`20NAM`20block`20for`20name`20processing
X$XABALL`09`09Controls`20disk`20space`20allocation
X$XABDAT`09`09Provides`20file`20date`20information
X$XABFHC`09`09Provides`20file`20header`20information
X$XABJNL`09`09Provides`20journaling`20information
X$XABKEY`09`09Provides`20additional`20key`20information
X$XABPRO`09`09Provides`20control`20over`20file`20protection
X$XABRDT`09`09Provides`20revision-date`20information
X$XABSUM`09`09Provides`20summary`20information
X$XABTRM`09`09Controls`20RMS`20terminal`20I/O
$ call unpack RMS.TXT;1 1460804631 ""
$!
$ create 'f'
X`09.TITLE`09TYPE
X`09.IDENT`09/01-000/
X;++
X;
X;`20`20Facility:`09TYPE
X;
X;`20`20Author:`09Hunter`20Goatley
X;`09`09goathunter@WKUVX1.BITNET
X;
X;`20`20Date:`09November`2015,`201992
X;
X;`20`20Abstract:
X;
X;`09This`20program`20is`20a`20no-frills`20version`20of`20TYPE`20that`20shows
X;`09some`20simple`20RMS`20calls`20to`20read`20a`20file.
X;
X;`20`20Modified`20by:
X;
X;`0901-000`09`09Hunter`20Goatley`09`0915-NOV-1992`2012:12
X;`09`09Original`20version.
X;
X;--
X
X`09.DSABL`09GLOBAL`09`09`09`09;`20Declare`20external`20references
X`09.ENABL`09SUPPRESSION`09`09`09;`20Don't`20list`20unreference`20symbols
X`09.NOSHOW`09BINARY`09`09`09`09;`20Include`20binary`20in`20listings
X;
X;`20`20External`20routines:
X;
X`09.EXTRN`09LIB$GET_FOREIGN`09`09`09;`20Get`20foreign`20command`20line
X`09.EXTRN`09LIB$PUT_OUTPUT`09`09`09;`20Write`20to`20SYS$OUTPUT
X
X`09$DSCDEF`09`09`09`09`09;`20Descriptor`20symbols
X`09$SSDEF`09`09`09`09`09;`20System`20service`20status`20symbols
X`09$FABDEF`09`09`09`09`09;`20Define`20FAB`20symbols
X`09$RABDEF`09`09`09`09`09;`20Define`20RAB`20symbols
X`09$RMSDEF`09`09`09`09`09;`20RMS`20status`20symbols
X
X`09.SHOW`09BINARY`09`09`09`09;`20Include`20binary`20in`20listings
X`0C
X`09.PSECT`09_TYPE_DATA,NOEXE,WRT,LONG,SHR
X
XINPUT_FAB:`09$FAB`09DNM=<SYS$DISK:`5B`5D.LIS>,-`09;`20The`20default`20name
X`09`09`09FAC=GET,-`09`09;`20Want`20to`20GET`20from`20file
X`09`09`09SHR=<GET,PUT>`09`09;`20Let`20others`20access`20it
X
XINPUT_RAB:`09$RAB`09FAB=INPUT_FAB,-`09`09;`20Point`20to`20FAB
X`09`09`09RAC=SEQ,-`09`09;`20Sequential`20access
X`09`09`09UBF=BUFFER,-`09`09;`20Input`20buffer`20addr
X`09`09`09USZ=512`09`09`09;`20Size`20of`20input`20buffer
X
XBUFFER:`09`09.BLKB`09512`09`09`09;`20Decent-sized`20buffer
X
X`09`09.ALIGN`09LONG`09`09`09;`20Align`20on`20longword`20boundary
XGET_FOREIGN_ARGS:`09`09`09`09;`20LIB$GET_FOREIGN`20arglst
X`09`09.LONG`093`09`09`09;`20...`203`20arguments
X`09`09.ADDRESS`20FILENAME`09`09;`20...`20The`20input`20buffer
X`09`09.ADDRESS`2010$`09`09`09;`20...`20The`20prompt
X`09`09.ADDRESS`20FILENAME`09`09;`20...`20Word`20to`20receive`20length
X`0910$:`09.ASCID`09/_File:`20/`09`09;`20Foreign`20command`20prompt
X
XFILENAME:`09.WORD`090`09`09`09;`20Dynamic`20descriptor`20for`20string
X`09`09.BYTE`09DSC$K_DTYPE_T`09`09;`20...`20Text`20string
X`09`09.BYTE`09DSC$K_CLASS_D`09`09;`20...`20Dynamic`20string
X`09`09.LONG`090`09`09`09;`20...`20Address`20filled`20in`20later
X
XOUTBUFF_D:`09.WORD`090`09`09`09;`20Static`20descriptor`20for`20string
X`09`09.BYTE`09DSC$K_DTYPE_T`09`09;`20...`20Text`20string
X`09`09.BYTE`09DSC$K_CLASS_S`09`09;`20...`20Static`20string
X`09`09.LONG`090`09`09`09;`20...`20Address`20filled`20in`20later
X
X`0C
X`09.PSECT`09_TYPE_CODE,EXE,NOWRT,LONG,PIC,SHR
X`09.ENTRY`09TYPE,`5EM<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
X;
X;`20`20Call`20LIB$GET_FOREIGN`20to`20get`20the`20filename
X;
X`09CALLG`09GET_FOREIGN_ARGS,-`09`09;`20Get`20the`20filename`20to`20TYPE
X`09`09G`5ELIB$GET_FOREIGN`09`09;`20...
X`09BLBC`09R0,40$`09`09`09`09;`20Branch`20on`20error
X`09
X;
X;`20`20See`20if`20a`20filename`20was`20even`20given.
X;
X`09MOVAQ`09FILENAME,R1`09`09`09;`20R1`20->`20filename`20descriptor
X
X`09MOVL`09#SS$_NORMAL,R0`09`09`09;`20Assume`20normal`20status
X`09TSTW`09DSC$W_LENGTH(R1)`09`09;`20Was`20there`20a`20length?
X`09BEQLU`0940$`09`09`09`09;`20If`20no`20filename,`20just`20exit
X
X;
X;`20`20Now`20make`20the`20FAB`20point`20to`20the`20filename`20using`20$FAB_STO
VRE.`20`20The`20FAB`20and
X;`20`20RAB`20addresses`20are`20copied`20to`20registers`20for`20efficiency.
X;
X`09MOVAL`09INPUT_FAB,R2`09`09`09;`20Move`20FAB`20address`20to`20R2
X`09MOVAL`09INPUT_RAB,R3`09`09`09;`20Move`20RAB`20address`20to`20R3
X
X`09$FAB_STORE`20-`09`09`09`09;`20Store`20the`20necessary`20FAB`20info
X`09`09FAB`09=`20(R2),-`09`09;`20...`20`20The`20FAB`20address
X`09`09FNA`09=`20@DSC$A_POINTER(R1),-`09;`20...`20`20The`20filename`20address
X`09`09FNS`09=`20DSC$W_LENGTH(R1)`09;`20...`20`20The`20filename`20length
X;
X;`20`20Now`20open`20the`20file`20using`20$OPEN
X;
X`09$OPEN`09FAB=(R2)`09`09`09;`20Try`20to`20open`20the`20file
X`09BLBC`09R0,40$`09`09`09`09;`20Branch`20on`20error
X;
X;`20`20Now`20connect`20the`20RAB`20to`20the`20open`20file
X;
X`09$CONNECT`20-`09`09`09`09;`20Connect`20the`20RAB`20to`20the`20file
X`09`09RAB=(R3)`09`09`09;`20...
X`09BLBC`09R0,20$`09`09`09`09;`20Branch`20on`20error
X
X`09MOVAQ`09OUTBUFF_D,R4`09`09`09;`20R4`20->`20output`20descriptor
X`09PUSHL`09#SS$_NORMAL`09`09`09;`20Push`20"normal"`20status`20on`20stack
X
X`2010$:`09$GET`09RAB=(R3)`09`09`09;`20Read`20a`20record`20from`20the`20file
X`09CMPL`09#RMS$_EOF,R0`09`09`09;`20Was`20EOF`20returned?
X`09BEQLU`0930$`09`09`09`09;`20Branch`20if`20so
X`09BLBC`09R0,20$`09`09`09`09;`20Branch`20on`20any`20other`20error
X`09MOVW`09RAB$W_RSZ(R3),DSC$W_LENGTH(R4)`09;`20Copy`20length`20to`20descriptor
V
X`09MOVL`09RAB$L_RBF(R3),DSC$A_POINTER(R4)`09;`20Copy`20address`20to`20descript
Vor
X`09PUSHAQ`09(R4)`09`09`09`09;`20Print`20the`20buffer`20to`20SYS$OUTPUT
X`09CALLS`09#1,G`5ELIB$PUT_OUTPUT`09`09;`20...
X`09BRB`0910$`09`09`09`09;`20Loop`20until`20EOF
X
X`2020$:`09MOVL`09R0,(SP)`09`09`09`09;`20Replace`20"normal"`20with`20error
X`2030$:`09$CLOSE`09FAB=(R2)`09`09`09;`20Close`20the`20file
X`09POPL`09R0`09`09`09`09;`20Restore`20saved`20status
X
X`2040$:`09RET`09`09`09`09`09;`20Return`20to`20caller
X
X`09.END`09TYPE
$ call unpack TYPE.MAR;1 1866758078 ""
$ v=f$verify(v)
$ exit