-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
X;95$:
X;`09jmp`09peek_err
X;100$:
X;`09$QIOW_S`09chan=in_channel,-
X;`09`09func=#<IO$_DEACCESS>,-
X;`09`09iosb=iosb,-
X;`09`09p1=infibdesc ,-
X;`09`09p5=out_attrib_list_ptr
X;`09blbc`09r0,105$
X;`09movzwl`09iosb,r0
X;`09blbs`09r0,110$
X;105$:
X;`09jmp`09peek_err
X;110$:
X;+
X; That's all; close channels and we're outta here!
X;-
X`09movl`09r0,r6`09`09`09; Save status...
X`09$DASSGN_S -`09`09`09; Deassign output channel
X`09`09chan=out_channel
X`09$DASSGN_S -`09`09`09; Deassign input channel
X`09`09chan=in_channel
X`09movl`09r6,r0`09`09`09; Restore status
X;
Xpeek_err:
X`09ret`09`09`09`09; Exit!
X;==========================================================================
X;+
X;  PEEK_ASSIGN: assign a VMS channel to a file specified only by CLI para-
X;`09meter-name.  Return channel number, modified FIB, and file`20
X;`09NAME.TYPE string.
X;
X;  Input:
X;
X;`09 4(AP) = CDU parameter-name, string by descriptor
X;`09 8(AP) = word to receive channel number, by reference
X;`0912(ap) = FIB to receive file information, by descriptor
X;`0916(ap) = address of descriptor to receive file name.type string
X;
X;  Output:
X;
X;`09 @8(AP) = channel number, word
X;`09@12(AP) = FIB, modified
X;`09@16(AP) = file name.type string, by descriptor
X;-
X`09.entry`09peek_assign,`5Em<r2,r3,r4,r5,r6,r7,r8>
X;+
X; Get handles on data structures we'll need...
X;-
X`09movab`09infile_access,r2`09; R2 => input-file FAB base addr
X`09movaq`09temp_descriptor,r3`09; R3 => input filename descr. addr
X`09movab`09expanded_spec,r4`09; R4 => expanded infilespec buff. addr
X`09movab`09parse_access,r5`09`09; R5 => input-file NAM block base addr
X;+
X; Get filespec from command line
X;-
X`09movl`09#string_size,(r3)
X`09pushal`09(r3)
X`09pushaq`09(r3)
X`09pushaq`09@4(ap)
X`09calls`09#3,g`5ECLI$GET_VALUE`09; Get output filespec
X`09blbs`09r0,10$`09`09`09; Set if successful
X`09jmp`09ass_err
X10$:
X;+
X; Install supplied filespec into FAB, and establish expanded-string buffer
X; pointer/length in NAM block:
X;-
X`09movb`09DSC$W_LENGTH(r3),FAB$B_FNS(r2)
X`09moval`09@DSC$A_POINTER(r3),FAB$L_FNA(r2)
X;
X`09movw`09#string_size,DSC$W_LENGTH(r4)`09`09; Initialize buffer
X`09movb`09DSC$W_LENGTH(r4),NAM$B_ESS(r5)`09`09; Install buffer into
X`09moval`09@DSC$A_POINTER(r4),NAM$L_ESA(r5)`09; NAM`20
X;+
X; Invoke RMS $PARSE service to obtain directory-ID etc. information for
X; ACP-QIO access to the named file.  (ACP-QIO interface requires device
X; and file specification as SEPARATE entities.)
X;-
X`09$PARSE`09fab=(r2)
X`09blbs`09r0,20$
X`09jmp`09ass_err
X20$:
X;+
X; Initialize some FIB fields:
X;-
X`09movab`09@12(ap),r6`09`09`09; R6 => FIB descr. addr
X`09moval`09@DSC$A_POINTER(r6),r7`09`09; R7 => FIB address
X;
X`09movw`09NAM$W_DID_NUM(r5),-`09`09; File's parent-directory
X`09`09FIB$W_DID_NUM(r7)`09`09; FID
X`09movw`09NAM$W_DID_SEQ(r5),-
X`09`09FIB$W_DID_SEQ(r7)
X`09movw`09NAM$W_DID_RVN(r5),-
X`09`09FIB$W_DID_RVN(r7)
X;+
X;  Move file name.type;version to supplied external storage
X;-
X`09pushr`09#`5Em<r0,r1,r2,r3,r4,r5>
X`09clrq`09-(sp)`09`09`09`09; Make room on stack for
X`09moval`09@NAM$L_NAME(r5),-`09`09; temporary string descriptor
X`09`09DSC$A_POINTER(sp)
X`09movzbl`09NAM$B_NAME(r5),-
X`09`09DSC$W_LENGTH(sp)
X`09addb2`09NAM$B_TYPE(r5),-`09`09; Length = name + type length
X`09`09DSC$W_LENGTH(sp)
X`09addb2`09NAM$B_VER(r5),-`09`09`09; + version length
X`09`09DSC$W_LENGTH(sp)
X;
X`09moval`09@16(ap),r8`09`09`09; R8 => "destination" descr.
X`09`09`09`09`09`09;       address
X`09movl`09DSC$W_LENGTH(sp),-`09`09; Copy source-to-dest LENGTH...
X`09`09DSC$W_LENGTH(r8)
X`09movc3`09DSC$W_LENGTH(sp),-`09`09; ... and character data.
X`09`09@DSC$A_POINTER(sp),-
X`09`09@DSC$A_POINTER(r8)
X;
X`09addl2`09#8,sp`09`09`09`09; Put back what we took from
X`09`09`09`09`09`09;  the stack!
X`09popr`09#`5Em<r0,r1,r2,r3,r4,r5>
X;+
X; Assign channel to device on which input file resides; this`20
X; involves extracting that device's name from the NAM block.
X;-
X`09subl2`09#8,sp`09`09`09`09; Reserve quadword on stack
X`09movzbl`09NAM$B_DEV(r5),DSC$W_LENGTH(sp)`09; Build descriptor; LENGTH...
X`09moval`09@NAM$L_DEV(r5),DSC$A_POINTER(sp); ... and ADDRESS!
X;
X`09$ASSIGN_S -`09`09`09`09; Assign VMS channel number
X`09`09chan=@8(ap),-`09`09`09; directly into external`20
X`09`09devnam=12(sp)`09`09`09; storage...
X`09addl2`09#8,sp
Xass_err:
X`09ret`09`09`09`09`09; Return status to caller
X;
X;
X`09.end`09filepeek
$ CALL UNPACK [.PEEK]PEEKFILE.MAR;1 124348922
$ v=f$verify(v)
$ EXIT