-h- asm.cmd Thu Jan 19 14:37:01 1984 ASM.CMD;1 .enable substitution MAC/LIS LB:[1,5]RMSMAC/LIB,lb:[rmspclib]RMRSX,'P1' PUR 'P1'.OBJ,'P1'.LST -h- delete.mac Thu Jan 19 14:37:01 1984 DELETE.MAC;1 .title delete Delete a named file .if ne RMSIO .ident /RMS005/ .iff .ident /000005/ .endc; ;+ ; ; Index Delete a named file ; ; Usage ; ; delete(filename) ; char *filename; ; ; Description ; ; ; Delete the named file. ; Returns 1 on success, 0 on error (such as file not found). ; If an error occurs, $$ferr can be checked for the error code. ; ; On RSX modes, the filename as passed need not include an explicit ; version number. If none is provided, file.nam;0 will ; be deleted. Note that the filename returned by fgetname() ; always includes an explicit version. ; ; On RT modes, the only error ever returned is "File not found". ; ; Bugs ; ; On RSX/VMS, the file must be in the user's current ("SET DEFAULT") ; directory. ; ; On RSTS, "SY0:" cannot be distinguished from "SY:". ; ;- ; ; Edit history ; 000001 28-May-81 MM Initial edit ; 000002 27-Jul-81 RBD Fixed rsx delete ; 000003 29-Jul-81 MM/JSL Various changes, delete returns 1 if ok, 0 on err ; 000004 27-Jun-82 MM For the new library, no substantive changes. ; RMS005 29-Dec-83 TTC Added RMS support. ; .iif ndf rsx rsx = 1 ;Assume RSX .if ne RMSIO .mcall $COMPARE $FETCH $ERASE ;05 .endc .psect c$code delete:: jsr r5,csv$ ;Linkage. clr r4 ;Go for a lun call $$flun ; r3 := lun .if ne rsx .if ne RMSIO ;05+ call $$fpar ;Parse the file name mov r4,r0 ;r0 -> iov add #V$FAB,r0 ;r0 -> FAB $ERASE r0 $COMPARE #SU$SUC,STS,r0 ;Successful? beq ok ;(Yes) $FETCH $$ferr,STS,r0 ;Error in $$ferr ;fall through to error exit ;05- .iff call $$fcsi ;Parse the file name mov r4,r0 ;r0 -> iov add #V$FDB,r0 ;r0 -> fdb mov r0,r1 ;r1 -> fdb ;02+ add #F.FNB,r1 ;r1 -> fnb call .find ;locate the file, filling in version number bcs 10$ ;nope ;03 call .dlfnb ;delete the file by file name ;02- bcc ok ;good ;03+ 10$: movb V$FDB+F.ERR(r4),r0 ;Get error code sign-extended mov r0,$$ferr ;and store in $$ferr global ;fall through to error exit ;03- .endc .iff .mcall .csispc, .close, .delete sub #39.*2,sp ;Get a csi area mov sp,r1 ;r1 -> csi area clr -(sp) ;Get a (fake) default extension mov sp,r2 ;r2 -> default extension .csispc r1,r2,c$pmtr+0(r5) ;Parse the file name bcs 10$ ;Bug if it won't parse ;03 mov r1,r2 ;Get another pointer to scratch area add #<3*5*2>,r2 ;r1 -> first input area .delete r1,r3,r2 ;Delete it bcc ok ;went well ;03+ 10$: mov #E$$FNF,$$ferr ;signal "file not found" .endc clr -(sp) ;Signal is "error" br skip ok: mov #1,-(sp) ;Signal is "all ok" skip: clr r0 ;Delete the iov call $$fcls ;Do close cleanup mov (sp)+,r0 ;Signal the error or whathaveyou ;03- jmp cret$ ;return to the caller .end -h- fclose.mac Thu Jan 19 14:37:01 1984 FCLOSE.MAC;1 .title fclose Close a currently-open file .if ne RMSIO .ident "RMS016" .iff .ident /000016/ .endc ; ;+ ; ; Index Close an open file ; ; Usage ; ; fclose(iop); ; FILE *iop; ; ; Internal ; ; mov #iov,r4 ;r4 -> i/o vector ; mov ,r0 ;r0 == 0 to free i/o vector ; call $$clos ;close file. ; ; mov #iov,r4 ;r4 -> i/o vector ; mov ,r0 ;r0 == 0 to free i/o vector ; call $$fcls ;Free buffer space ; ; Description ; ; Close the file. Returns 0 if ok, -1 if an error. ; The error code is saved in $$ferr. ; ; Note that stderr is never closed. On RT11-mode, the ; last block of a disk file which was open for output ; is filled with nulls. ; ; Internal ; ; $$clos is called internally to close a file. ; ; $$fcls is called internally to free buffer space. ; ; After the file has been closed, record buffers (RSX-mode) ; and the file-name buffer (RT11-mode) will be freed. ; ; If r0 is zero on entry, the iov and any wild-card buffer will ; also be freed. This flag is set non-zero by freopen() or ; fnext() to close a file without freeing the iov. ; ; Bugs ; ;- ; ; Edit history ; 000001 18-May-79 MM Modified for the new library ; 000002 10-Mar-80 MM Modified for the newer library ; 000003 14-Mar-80 MM Added $$fcls entry for fmkdl ; 000004 27-Mar-80 MM Merged libraries ; 000005 21-May-80 MM Added $$clos and iov deletion test ; 000006 11-Jun-80 MM Support for fwild ; 000007 22-Jun-80 MM RT11 and RSX squished together ; Note: edit numbers edited out ; 000008 26-Jun-80 MM Added wild-card buffer removal ; 000009 14-Jul-80 MM Check for file name buffer ; 000010 01-Aug-80 MM Track IOV changes, added $$cflu ; 000011 14-Oct-81 MM Split out $$clfu as a separate program ; 000012 08-Feb-82 MM Incorporate Unimation changes -- close rsx record ; format files in SEEable format. ; 000013 27-Jun-82 MM New library. ; 000014 03-Aug-82 MM Make edit 12 work on RSTS/RSX ; 000015 22-Dec-82 RBD Do not call $$flsh on RT11 ; RMS016 17-Dec-83 RBD Add conditional support for RMS-11(V2) ; .iif ndf rsx rsx = 1 ;Assume RSX11M .if ne rsx .if ne RMSIO .mcall $CLOSE $FETCH $COMPARE ;16 .iff .mcall CLOSE$ .endc .iff .mcall .CLOSE .endc .psect c$code fclose:: jsr r5,csv$ ;Get stack frame. mov #cret$,(sp) ;$$clos returns to caller clr $$ferr ;No errors. mov C$PMTR+0(r5),r4 ;Pick up ioptr. beq errxit ;How can I close nothing? clr r0 ;Dump iov signal $$clos:: .if ne rsx ;15 bit #VF$WRT,V$FLAG(r4) ;If it's an input file, ;14+ beq 5$ ;Skip the flush call $$flsh ;Output file, flush last record .endc ;15 5$: cmp r4,stderr ;Stderr never closes beq done ;Just return to the caller mov r0,-(sp) ;Save iov signal ;14- ; ; Do a quick check to see that it's in the Lun table ; movb V$LUN(r4),r0 ;Get Lun number asl r0 ;* 2 as an index .if ne rsx cmp r4,$$luns-4(r0) ;Does it match? .iff cmp r4,$$luns(r0) ;Does it match? .iftf beq 10$ ;Keep on trucking if so tst (sp)+ ;Pop the stack br errxit ;and die 10$: bit #VF$FIL,V$FLAG(r4) ;Is it a file ;12+/13/14 beq 15$ ;Skip see flush if not ;14 bit #VF$OPN,V$FLAG(r4) ;Is it really open? ;13 beq noclos ;Skip close if not call $$cflu ;Clean up last record 15$: .ift mov r4,r0 ;RSX Make r0 point to .if ne RMSIO add #V$FAB,r0 ;RSX File access block ;16+ $CLOSE r0 ;RSX Close it out $COMPARE #SU$SUC,STS,r0 ;RSX Successful? beq 20$ ;RSX Good exit $FETCH r0,STV,r0 ;RSX Get error code ;16- .iff add #V$FDB,r0 ;RSX file data block CLOSE$ r0 ;RSX Close it out bcc 20$ ;RSX Good exit movb F.ERR(r0),r0 ;RSX Get error code (sign extended) .endc mov r0,$$ferr ;RSX to error global 20$: .iff bit #VF$TTY,V$FLAG(r4) ;RT11 If it's really a terminal ;13 bne noclos ;RT11 Nothing to close .close V$LUN(r4) ;RT11 Close the file .endc noclos: mov (sp)+,r0 ;recover iov dump flag ; ; Enter at $$fcls to free up space. r0 is zero to free the iov ; $$fcls:: mov r0,-(sp) ;save signal .if ne rsx mov V$BBUF(r4),r0 ;RSX Block buffer. beq 30$ ;RSX Br if none. call $$free ;RSX Free it. clr V$BBUF(r4) ;RSX Mark no more 30$: ;13+ .iftf ;09+ mov V$BASE(r4),r0 ; Record buffer. beq 40$ ; Br if none. bit #VF$MBUF,V$FLAG(r4) ; But, do we own it? beq 40$ ; Br if not call $$free ; Free it clr V$BASE(r4) ; Mark no more bic #VF$MBUF,V$FLAG(r4) ; Nothing there now 40$: .iff ;13- mov V$NAME(r4),r0 ;RT11 File name beq 45$ ;RT11 If it's there ;09- call $$free ;RT11 Now it's gone 45$: ;09 .iftf tst (sp)+ ; keep the iov? bne 60$ ; br if so ;08+ .ift mov V$DNAM(r4),r0 ;RSX Directory name buffer beq 47$ ;RSX Br if none. call $$free ;RSX Mark no more clr V$DNAM(r4) ;RSX No more 47$: .iftf mov V$WILD(r4),r0 ; Wild card buffer beq 50$ ; None present call $$free ; Really none present 50$: ;08- movb V$LUN(r4),r0 ; Get the lun asl r0 ; as an index .ift clr $$luns-4(r0) ;RSX Clear the entry .iff clr $$luns(r0) ;RT11 Clear the entry .endc mov r4,r0 ;Free IOV. call $$free ; ;02 60$: mov $$ferr,r0 ;Return 0 if no errors. ;02 beq done ;Br if all ok. errxit: mov #-1,r0 ;Urk done: return ;return to caller ;05 .end -h- fgetna.mac Thu Jan 19 14:37:01 1984 FGETNA.MAC;1 .title fgetname Convert file name to Ascii .if ne RMSIO .ident "RMS013" .iff .ident /000013/ .endc ; ;+ ; ; Index Convert file name to Ascii ; ; Usage ; ; char * ; fgetname(iop, buffer); ; FILE *iop; ; char *buffer; ; ; Description ; ; Convert the file name to Ascii and put it in the buffer. ; ; On native RSX (and RSTS/E emulation) the device name, ; file name, file type, and version are converted to Ascii. The UIC ; is converted if it was specified and differs from the job's ; default UIC. (Note that on VMS compatibility mode, the ; UIC is unavailable.) The version is converted to octal on ; native RSX and to decimal on VMS emulation. The result should ; be sufficient to delete the file. ; ; On RT11 modes, the file name passed to fopen() is copied to ; the buffer without further processing. If the file was opened ; by an fwild()/fnext() sequence, the correct file name is ; returned. (On RSTS/E, the PPN is returned as well.) ; ; Fgetname() returns a pointer to the buffer argument. ; ; Fgetname() is present in the Vax-11 C support library, but ; is not generally present on Unix implementations. ; ; Note that fgetname() returns a fully-qualified file specification ; including, where possible, the disk, directory, and version ; of the file. If only the actual file name is needed, the ; following code segment may be executed. As shown, it writes ; the file name and filetype (extension) to a global "buffer". ; ; getfilename(fd, buffer) ; FILE *fd; ; register char *buffer; ; { ; register char *tp; ; register char c; ; ; fgetname(fd, buffer); ; /* ; * Skip over node and device name ; */ ; while ((tp = strchr(buffer, ':')) != NULL) ; strcpy(buffer, tp + 1); ; /* ; * Skip over [UIC] or [PPN] if present ; */ ; c = EOS; ; switch (*tp) { ; case '[': c = ']'; break; ; case '(': c = ')'; break; ; case '<': c = '>'; break; ; } ; if (c != EOS ; && (tp = strchr(buffer, c)) != NULL) { ; strcpy(buffer, tp + 1); ; /* ; * Don't include version ; */ ; if ((tp = strchr(buffer, ';')) != NULL) ; *tp = EOS; ; } ; ; Bugs ; ; Various operating systems behave differently. ; ;- ; ; Edit history ; 000001 24-Jul-79 MM Initial edit ; 000002 11-Mar-80 MM Conversion for the newer C library ; 000003 27-Mar-80 MM Added RT11 support ; 000004 09-Jun-80 MM Debugged ; 000005 22-Aug-80 MM Reversed $$fdba arguments (bummed code) ; 000006 16-Sep-80 MM Merged fdbta.mac into iovtoa.mac, much hackery ; 000007 17-Nov-80 MM More hackery ; 000008 10-Dec-80 MM Changed VMS test -- no functional changes ; 000009 28-May-81 MM Changed iovtoa to fgetname ; 000010 16-Sep-81 MM Don't do '_' for RSX-11M PLUS ; 000011 27-Jun-82 MM Newer library -- include directory name stuff ; RMS012 17-Dec-83 RBD Add conditional support for RMS-11(V2) ; RMS013 29-Dec-83 TTC Fix bug to get pointer to NAM block properly ; and restore r2 before returning. ; .iif ndf rsx rsx = 1 ;Assume RSX .if ne rsx .if ne RMSIO ;12+ .mcall $FETCH .psect c$code ; ; This routine should work whether or not wildcarding is in ; progress. If the "resultant" string length is zero, use the ; "expanded" string. ; fgetname:: mov r2,-(sp) ;Save r2 mov 4(sp),r1 ;r1 --> iov mov r1,r2 ;r2 --> iov ;13 add #v$nam,r2 ;r2 --> NAM block ;13 $FETCH r0,RSL,r2 ;r0 = resultant string length beq 10$ ;(none present) $FETCH r1,RSA,r2 ;r1 --> resultant string br 20$ 10$: $FETCH r0,ESL,r2 ;r0 = expanded string length $FETCH r1,ESA,r2 ;r2 --> expanded string 20$: add r1,r0 ;r0 --> last byte + 1 clrb (r0) ;Null terminate string mov 6(sp),r0 ;r0 --> output buffer 30$: movb (r1)+,(r0)+ ;Copy the string bne 30$ mov 6(sp),r0 ;Get back the buffer arg. mov (sp)+,r2 ;Restore r2 ;13 return ;12- .iff .psect c$code .mcall fdof$l,nbof$l fdof$l nbof$l ISRSX = 1 ISMPL = 6 ; RSX-11M Plus ;10 fgetname:: ;09 jsr r5,csv$ tst -(sp) ; Get a temp ;11 mov C$PMTR+0(r5),r4 ;Get IOV pointer mov C$PMTR+2(r5),r0 ;r0 -> buffer mov #itoa,r2 ;Assume RSTS' decimal PPN and unit no's tst $$rsts ;Well? bne 10$ ;Br if RSTS/E mov #itoa8,r2 ;Some people will never learn 10$: ; cmp $$opsy,#ISRSX ;Running on native RSX beq 12$ ;Yes, don't do underscore cmp $$opsy,#ISMPL ;Running on RSX-11M PLUS ;10 beq 12$ ;Yes, don't do undersore ;10 mov v$dnam(r4),r3 ;r3 -> directory name (for vms) ;11+ beq 1020$ ;Don't have one 1010$: movb (r3)+,(r0)+ ;output the directory name bne 1010$ ;all of it dec r0 ;r0 -> last byte mov #itoa,r2 ;Going to do decimal version numbers br nouic ;done all uic stuff now. 1020$: movb #'_,(r0)+ ;We don't want logical name translation 12$: movb v$fdb+f.fnb+n.dvnm(r4),(r0)+ ;Output device name movb v$fdb+f.fnb+n.dvnm+1(r4),(r0)+ ;both bytes mov v$fdb+f.fnb+n.unit(r4),(sp) ;Unit number ;11 tst $$vms ;Running on RSX under VMS emulation ;08 beq 14$ ;No ;08 mov #itoa,r2 ;VMS uses decimal unit numbers mov (sp),r3 ;Get unit number asr r3 ;Divide asr r3 ; by asr r3 ; sixteen asr r3 ; bic #360,r3 ;Mask out all but the low octad add #'A,r3 ;Change DB20: to DBB0: movb r3,(r0)+ ;Output it bic #360,(sp) ;Keep low octad of unit number 14$: mov r0,2(sp) ;buffer address call (r2) ;convert it -- itoa[8] updates r0 movb #':,(r0)+ ;Syntactic colon mov v$uic(r4),r3 ;Get UIC/PPN beq nouic ;Exit if none given cmp r3,$$uic ;If the same as the task caller's beq nouic ;Don't convert it 20$: movb #'[,(r0)+ ;Output the bracket mov r0,2(sp) ;Update the buffer pointer mov r3,(sp) ;UIC swab (sp) ;Want the group, first bic #177400,(sp) ;Just the low byte, please call (r2) ;Call the converter movb #',,(r0)+ ;Syntatic comma mov r0,2(sp) ;Update buffer pointer mov r3,(sp) ;Now for the bic #177400,(sp) ;Member call (r2) ;Off we go movb #'],(r0)+ ;More syntax ; ; No need to hack uic's ; nouic: mov v$fdb+f.fnb+n.fnam(r4),r1 ;Get file name bne 10$ ;Br if first part's there tst v$fdb+f.fnb+n.ftyp(r4) ;No name, is there a type? bne 10$ ;Strange, but do it anyway br 20$ ;and exit for now 10$: ; call $$c5ta ;Convert all mov v$fdb+f.fnb+n.fnam+2(r4),r1 ;three call $$c5ta ;parts mov v$fdb+f.fnb+n.fnam+4(r4),r1 ;of call trim ;it and trim off blanks movb #'.,(r0)+ ;The dot mov v$fdb+f.fnb+n.ftyp(r4),r1 ;The file type call trim ;Convert and trim blanks mov v$fdb+f.fnb+n.fver(r4),(sp) ;Version number ble 20$ ;Assume any 0 or -ve is ;0 movb #';,(r0)+ ;Convert version number mov r0,2(sp) ;Buffer for itoa[8] call (r2) ;convert to ascii 20$: clrb (r0) ;Make sure it's terminated mov c$pmtr+2(r5),r0 ;return -> buffer argument jmp cret$ ;And exit trim: call $$c5ta ;Convert 10$: ;and then cmpb #040,-(r0) ;Loop to trim blanks beq 10$ ;around we go inc r0 return .endc .iff .psect c$code fgetname:: mov 2(sp),r1 ;r1 -> IOV mov 4(sp),r0 ;r0 -> output buffer mov V$NAME(r1),r1 ;r1 -> file name 10$: movb (r1)+,(r0)+ ;Output the bne 10$ ;name mov 4(sp),r0 ;Get back the buffer arg. return ;Simplicity itself. .endc .end -h- fopen.mac Thu Jan 19 14:37:01 1984 FOPEN.MAC;2 .title fopen C library file opener .if df rmsio .ident "RMS044" .iff .ident /000044/ .endc ; ;+ ; ; Index Open or reopen a file ; ; Usage ; ; FILE * ; fopen(name, mode); ; char *name; /* File to open */ ; char *mode; /* Open modes */ ; ; FILE * ; freopen(name, mode, iop); ; char *name; /* File to open */ ; char *mode; /* Open modes */ ; FILE *iop; /* I/O pointer */ ; ; Internal ; ; mov iov,r4 ;r4 -> iov ; jmp $$fopn ;Open the file and return to the ; ;caller via $$fopx or $$fope if error. ; ;On RSX, fixup append mode if the file ; ;wasn't found. ; ; mov iov,r4 ;r4 -> iov ; call $$fopo ;Normal open, then exit via $$fopx ; ;On RSX, $$fopo returns if any error ; ;occurred. On return, r0 := RSX error code. ; ; mov iov,r4 ;r4 -> iov, file is open ; jmp $$fopx ;Normal exit from fopen ; ;On RSX, $$fopx allocates the record ; ;buffer. ; ; mov iov,r4 ;r4 -> iov (or r4 == 0) ; mov code,r0 ;r0 := error code (to go to $$ferr) ; jmp $$fope ;Error exit from fopen ; ;$$fope deallocates buffers ; ; Description ; ; Fopen opens a new or existing file in the indicated mode: ; ; r Read the existing file sequentially ; w Create and write the file sequentially ; a Append to the file ; n Not record oriented ; u RSX-mode "unbuffered i/o" ; RT11-mode: use .ttyin and .ttyout ; ; ; Either "r", "w", or "a" must be given. "n" and "u" are ; optional. "n" should be given for "binary" files. ; Note that "n" mode will create fixed-block records on ; RSX systems. Append mode does not work on native RT11. ; ; Note that "n" and "u" are not compatible with other ; Unix systems. ; ; Implementation Details ; ; On RSX, "u" mode files will be created with the ; "variable-length" attribute. On RSTS/RSX emulation, text ; files (neither "n" nor "u" specified) will be created with ; "stream" attribute. ; ; On RSX, if the record type bits in the record attribute byte ; (F.RATT in the FDB) is zero, the file will be read as if ; the "n" was specified. Note that, if the file contains ; carriage-return line-feed sequences, the entire sequence ; will be passed to the user's program. If record attributes ; are understandable, the carriage-return will be deleted ; from sequences. ; ; On RSX, if the "file" is being opened for write to the same ; device/unit ; as stderr (the user's "command console), the character stream is ; diverted to stderr. This avoids synchronization problems by ; funnelling all output through the same buffer. In ; addition, output to any terminal device is done via QIO's to ; the terminal, IO.WLB for normal mode, IO.WAL for "n" mode. ; ; On RT11, when opening a file for writing, a specific block ; allocation may be included in the Ascii file specification ; following standard RT-11 syntax: "DKn:file.nam[nnn]" where the ; "nnn" specifies the number of blocks to allocate to the file. ; After opening a file successfully, the actual file size (or ; number of blocks allocated) will be found in (FILE *)fd->io_size. ; ; If the RT11 library decides that the file is really the user's ; command terminal, single-character I/O will be performed (by ; calling .ttyin and .ttyout). Note that the "special-mode" ; bits must be set in the Job Status Word by the program if it requires ; true single-character or immediate return input. Output to the ; terminal will be performed without buffering, which is useful ; for screen updating, but otherwise expensive. ; ; Fopen() returns NULL on errors -- $$ferr gets an error code. ; On RT11, this will be a RSTS/E compatible code (described in ; iov), while on RSX, this will be the FCS error code. ; ; On RT11, the file name pointed to by the "io_name" field of ; the iov is either the file name string as passed to fopen() ; or an ascii string reconstructed from the 4-word Rad50 ; device block if the file was opened as part of a fwild/fnext ; sequence. By saving the ascii string, RSTS/E is able to ; re-parse logical device names and PPN's, which are not present ; on native RT11. ; ; On VMS compatibility mode, the device and directory of the ; file name argument are saved in the iov "io_dname" ; field for use by fgetname(). ; ; Note that "no buffer space available" (IE.NBF or E$$NSP) and ; "invalid lun" (IE.ILU or E$$NOC) may be generated by fopen. ; On RT11, if the file cannot be opened because the user's program ; has already opened the channel, an E$$ILU error will be returned. ; ; The same file may not be used for both reading and writing ; except if the program writes a disk file, then repositions ; and reads it using ftell()/fseek(). In this case, the program ; should call rewind() or freopen() to reinitialize the file before ; using fseek(). ; ; Except in the one specific case of the RT11 console terminal ; open in "u" mode, an open file must not be used for reading ; and writing at the same time. ; ; Freopen() substitutes the named file in place of the open ; file -- indicated by iop. The file currently open on ; iop is closed. Freopen returns iop. If the open failed, ; iop will be deallocated. Note that freopen loses any pending ; fwild/fnext status. ; ; ; Internal ; ; The following routines/globals are for use by fopen/fwild. ; If any of these routines detect an error, they return to the ; fopen() caller with an appropriate error code in $$ferr. ; ; $$fope Error exit from fopen ; $$fopn Normal open, hack append ; $$fopx Normal exit from fopen ; ; Warning: fopen() in RSX/RSTS mode uses unpublished information ; to obtain the PPN [UIC] of an open file. This code (in iocsi.mac) ; may require modification for subsequent releases of RSTS/E. ; ; Bugs ; ; Append mode cannot work on native RT11 given the design of the ; RT11 file system. ; ; The RT11 file system does not support files greater than ; 65535 blocks long. ; ; RT11 does not get the actual keyboard name of the console ; terminal, although this isn't too hard to do on RT11/RSTS/E. ; ; Freopen() cannot be used to assign a file to stderr as there ; is code throughout the i/o package for special treatment of ; stderr. For example, it cannot be closed by a user-written ; program. ; ; In RSX modes, the maximum number of files that may be simultaneously ; open is defined at assembly time by a macro (FSRSZ$) which is ; expanded when fopen.mac is assembled. The default FSRSZ$ ; parameter is 4. This may be modified by using the task builder ; /ACTFIL=n option. The default FSRSZ$ value may be specified ; when the RSX library is built by editing assembly parameter ; N$$FIL in RSX.MAC. ; ; Internal ; ; This module contains release-specific code for VMS V3.0 to ; enable Decus C programs to read "Ascii stream" files. ; ;- ; ; Edit history ; 000001 24-Jul-79 MM Initial edit ; 000002 10-Mar-80 MM Conversion for the newer library ; 000003 27-Mar-80 MM Merged libraries ; 000004 23-May-80 MM Added freopen(), changed RT11 stuff ; 000005 10-Jun-80 MM Reorganized for fwild/fnext ; NOTE: because of the reorganization, edit codes ; have been removed from RSX fopen ; 000006 15-Jun-80 MM More reorganization ; 000007 22-Jun-80 MM Reorganized RT11 stuff. NOTE: because of the ; reorganization, edit codes have been removed ; from RT11 fopen. ; 000008 02-Jul-80 MM Fixed dumb bug in $$flun ; 000009 06-Jul-80 MM Added Stream under RSTS/E ; 000010 09-Jul-80 MM Do a handler .fetch on RT11 ; 000011 10-Jul-80 MM Fixed typo in .dstatus call ; 000012 18-Jul-80 MM Fixed up RT11 error status values ; 000013 01-Aug-80 MM Track IOV changes ; 000014 17-Aug-80 RBD Slight mods for RT11 fwild(). Changed stashed file ; spec to the 4 word RAD50 CSI output 'dblk'. This ; is consistent with fwild(), which does the same. ; 000015 22-Aug-80 MM Reverted to storing an ascii file name for RT11. ; This is needed to preserve logical device translation ; for RSTS. There is some unfortunate hackery for ; wild card files, as the 4-word device block must ; be decompiled to ascii. No simple solutions. ; 000016 04-Sep-80 MM Squeeze blanks from RT11 filenames ; 000017 16-Sep-80 MM Get RSX Directory UIC ; 000018 18-Sep-80 MM Bug in .parse call, fixed .psect names, added N$$FIL ; 000019 22-Sep-80 RBD Minor changes (improvements) to uic handling. ; 000020 23-Sep-80 MM Fix to RT11 file scan, removed VF$BAD ; 000021 20-Oct-80 MM Bit by Standard Runoff on VMS -- missing attributes ; 000022 24-Oct-80 MM Bit again. Missing attributes on VMS differnt ; 000023 10-Dec-80 MM Changed vms test -- no functional changes ; 000024 24-Dec-80 MM Use blank-squeezed RT11 filename (change 000016) ; 000025 06-Jan-81 JSL Make append mode work on RT11/RSTS ; 000026 17-Feb-81 MM Another runoff hack (see patch 21,22) This one's sick ; 000027 02-Mar-81 MM $$fopo returns on any error. Needed for fwild() ; 000028 14-Apr-81 MM Added "elephant directive" for VMS ; 000029 02-Jun-81 RBD Enable tkb ACTFIL option ; 000030 05-Aug-81 RBD Allow RT11 filesize, other hacks ; 000031 07-Aug-81 MM "n" mode gives R.FIX output files ; 000032 17-Aug-81 RBD Properly set VF$FIL on RSX. ; 000033 21-Aug-81 MM Fix edit 31 (R.VAR for normal output on RSX or VMS) ; 000034 28-Aug-81 MM Branch becomes a JMP on RT11 ; 000035 14-Oct-81 MM Broken into lots of little modules ; 000036 15-Jun-82 MM Stupendous vms v3.0 patch. ; 000037 27-Jun-82 MM New library stuff: directory name, different offsets. ; 000038 26-Jun-82 MM Terminal frob -- see IOPUT.MAC for the gory details. ; 000039 04-Oct-82 MM Set VF$CMD bit if tty is open on same terminal as stderr ; 000040 27-Oct-82 RBD Unterminal unfrob. See INIT.MAC for additional gore. ; P.S ... Isn't it time for a rewrite of this mess?? (RBD) ; Any volunteers? ; 000041 22-Nov-82 TTC Fix append bug. Must clear read as well as append bit, ; if get no such file error on first try. ; RMS042 13-Dec-83 RBD (TTC also) Add conditional support of RMS-11 ; RMS043 17-Dec-83 RBD Clean up RMS stuff (HUH? CLEAN?? well ...) ; RMS044 11-Jan-84 RBD Fix so "wun" does R.VAR binary files, and RMS flavor ; properly initializes the FAB's MRS field for "n" files ; .iif ndf rsx rsx = 1 ;Assume RSX11M .iif ndf vms3.0 vms3.0 = 0 ;Don't assume hack. ; ; Note the following tests (set in $$fopt) ;37+ ; ; reading: V$FLAG(r4) & VF$REA ; writing: V$FLAG(r4) & VF$WRT ; append: V$FLAG(r4) & VF$APN ;37- ; .if ne rsx .if ne RMSIO .MCALL $FETCH $STORE $OFF $SET $TESTBITS $COMPARE ;42 .MCALL $OPEN $CREATE $CONNECT ;42 .psect c$data .iff .IIF NDF N$$FIL N$$FIL = 8. ;Number of files ;18 F.BFHD == 20 ;For TKB so ACTFIL option works. ;29+ ;When TKB gets to the psect expansion ;section, if F.BFHD is not defined, ;ACTFIL is ignored (F.BFHD is defined in ;the fortran library). TKB adds the ;value of F.BFHD + 512. (hard-wired), ;multiplies this by ACTFIL, and makes ;$$FSR1 this size. Happy now? ;29- .MCALL FDBDF$, FDAT$R, FDOP$R .MCALL FDBK$R, FDRC$R, FSRSZ$, FDOF$L .MCALL OFNB$A, OFNB$R, OFNB$W FDOF$L R.STM = 4 ;Ascii stream record attribute. ;09 ;NOTE: R.STM is unpublished ;WARNING: This bit has been known to ;be set on VMS "Print format" files. .psect c$data ; ; Since the RSX people do not understand reentrant coding, ; the file system must be defined at assembly time. ; ; Note -- code in subroutine $$falo depends on the undocumented ; fact that a dummy file data block is all zero. ; FSRSZ$ N$$FIL ;Define block buffer area ;18 .endc ; .psect c$code FREOPE:: JSR R5,CSV$ ;C save sequence MOV C$PMTR+4(R5),R4 ;Get IOV pointer MOV R4,R0 ;Make R0 non-zero CALL $$CLOS ;Close file, keep IOV BR FOPEN1 ;Continue with main sequence ; FOPEN:: JSR R5,CSV$ ;C save sequence CLR R4 ;Clear IOV pointer, too FOPEN1: ;Common code for fopen, freopen CALL $$FLUN ;Get a Lun CALL $$FOPT ;Scan options string .if ne RMSIO CALL $$FPAR ;Parse the file spec, set up the FAB ;42 .iff CALL $$FCSI ;Parse the CSI string, setup the FDB .endc ;BR $$FOPN ;And open the file ; ; ** $$FOPN ; ; Open the file. This code is specific to fopen/freopen (and fwild if ; no wildcards were found.) ; ; Note: if append and file-not-found, restart for writing ; $$FOPN:: CALL $$FOPO ;Try to open it BIT #VF$APN,V$FLAG(R4) ;Oops, append mode? ;26+/37 BEQ 10$ ;No, return fatally CMPB R0,#IE.NSF ;Append, no such file? BNE 10$ ;No, sorry. BIC #VF$REA!VF$APN,V$FLAG(R4) ;Clear out the mode bits ;37/41 BIS #VF$WRT,V$FLAG(R4) ;Make it a write open ;37 BR $$FOPN ;And try, try, try. 10$: JMP $$FOPE ;Sorry ;26-;35 ; ; ** $$FOPO ; ; Actually open the file which has been setup by $$FCSI (or fnext()) ; If the file opened correctly, there is no return -- the program ; exits to the fopen/fnext caller via $$fopx. On error, $$FOPO ; returns to the caller with the error code in R0. ; $$FOPO:: MOV R4,R0 ;Get IOV .if ne RMSIO MOV R4,R1 ;R1 --> IOV ;42+ ADD #V$FAB,R0 ;R0 --> FAB ADD #V$RAB,R1 ;R1 --> RAB ;42- .iff ADD #V$FDB,R0 ;R0 -> fdb .endc BIC #VF$NOS,V$FLAG(R4) ;Clear current VF$NOS ;26+/37 BIT #VF$NLH,V$WFLG(R4) ;fopen/fwild (..., "n") ;37 BEQ 4$ ;Br if not BIS #VF$NOS,V$FLAG(R4) ;(re)set the bit ;37 ; ; The above mess is needed if, on vms, the program executes fwild() and ; the first file was a .MEM file (which has no attributes) while the ; second file is a "vanilla" ascii file. (FOO.MEM, FOO.RNO). VF$NOS ; is forced for FOO.MEM, but must be zero for FOO.RNO. Sorry, but it's ; the best I could come up with. ; 4$: ;26- BIT #VF$NBF,V$FLAG(R4) ;User buffered? ;37 BEQ 10$ ;No, continue ; ; User-buffering. (The following may have to change) ; .if ne RMSIO $SET #FB$GET!FB$PUT,FAC,R0 ;42 .iff FDRC$R R0 ;I/O via GET$ and PUT$ FDBK$R R0 ;No block buffers .endc BR DOOPEN ;Continue main sequence ; ; I/O package does buffering (record buffer in V$RBUF). ; 10$: BIT #VF$NOS,V$FLAG(R4) ;No newlines wanted? ;37 BNE 20$ ;Branch if so. .if ne RMSIO $SET #FB$CR,RAT,R0 ;42 20$: $SET #FB$GET!FB$PUT,FAC,R0 ;42 .iff FDAT$R R0,,#FD.CR ;Want them, so ask for it. 20$: FDRC$R R0 ;Setup for GET$ or PUT$ FDOP$R R0 ;Initialize file open section .endc ; ; Now for the fun part (sick is more like it!) ; ; At this point R0 --> FDB (FCS) ; or ; R0 --> FAB (RMS) ; R1 --> RAB (RMS) ; DOOPEN: BIT #VF$WRT!VF$APN,V$FLAG(R4) ;Reading ;37 BNE 10$ ;Nope .if ne RMSIO $OFF #FB$PUT,FAC,R0 ;Reading ... don't touch file ;42 $OPEN R0 ;Open existing ;42 .iff OFNB$R R0 ;Yep, try for it .endc BR 30$ ;Main sequence 10$: BIT #VF$APN,V$FLAG(R4) ;Append? ;37 BEQ 20$ ;Nope, go open for write ;37 .if ne RMSIO $SET #RB$EOF,ROP,R1 ; Position RAB to EOF ;42 $OPEN R0 ;42 .iff OFNB$A R0 ;Try opening for append .endc BR 30$ ;Onward ;26 ; 20$: ;+ ;42+ ; *** NOTE - RSTS STREAM STUFF REMOVED *** ;- BIT #VF$NOS,V$FLAG(R4) ;"n" mode? BEQ 25$ ;(no) BIT #VF$NBF,V$FLAG(R4) ;"u" mode? ;44 BNE 25$ ; "u" always veriable length ;44 .if ne RMSIO $STORE #FB$FIX,RFM,R0 ;"n" -- Fixed length ;42 $STORE #512.,MRS,r0 ; 512-byte "records" ;44 BR 26$ ;42 .iff FDAT$R R0,#R.FIX ;"n" mode, do fixed length output BR 26$ ;Continue ;31- .endc 25$: ;True RSX or RSX/VMS stream output or .if ne RMSIO $STORE #FB$VAR,RFM,R0 ;"u" or "un" -- Variable length ;42 .iff FDAT$R R0,#R.VAR ;"u" or "un" -- do variable length .endc 26$: ;09 .if ne RMSIO $CREATE R0 ;42+ 30$: $COMPARE #SU$SUC,STS,R0 BNE 40$ $CONNECT R1 $COMPARE #SU$SUC,STS,R1 BEQ $$FOPX MOV R1,R0 ;42- .iff OFNB$W R0 ;Go for it 30$: BCC $$FOPX ;Any errors -- do final cleanup if not .endc ; 40$: .if ne RMSIO $FETCH R0,STS,R0 ;Error code ;42 .iff MOVB F.ERR(R0),R0 ;Error code (sign extended) .endc RETURN ;And let high-level stuff do it ;26 ; ; ** $$FOPX ; ; Normal exit from fopen(). Enter with r4 -> fdb. Returns to fopen ; caller after allocating buffers and setting flag bits. Note: ; the file has been successfully opened, but record buffers have not ; been allocated. ; ; NOTE: If the file is being opened to the same device/unit as stderr, ; the VF$CMD bit is set, indicating that the "file" is actually ; just another channel to the user's "command console". Elsewhere, ; output is diverted to stderr so all console output uses the ; same buffer, nicely avoiding synchronization problems. Thank ; you, Martin!. ; $$FOPX:: BIS #VF$OPN,V$FLAG(R4) ;Mark opened for $$clos and fnext() ;37 BIC #VF$EOR,V$FLAG(R4) ;Ensure not at end of file ;37 .if ne RMSIO MOV R4,R2 ;42+ ADD #V$FAB,R2 ; R2 --> FAB MOV #512.,V$RBSZ(R4) ; 512-byte max record on RMS ;43 $FETCH R0,DEV,R2 ; R0 = Record flag bits ;42- .iff MOV V$FDB+F.VBSZ(R4),V$RBSZ(R4) ;Get Virtual record size MOVB V$FDB+F.RCTL(R4),R0 ;R0 := Record flag bits TST $$VMS ;On vms? ;22/23 BEQ 5$ ;No, onward ;22/23 BITB #7,V$FDB+F.RATT(R4) ;Any attribute bits ;21+ BNE 5$ ;Yes, continue BIS #VF$NOS,V$FLAG(R4) ;No, not stream ;21-/37 5$: .ift $TESTBITS #,DEV,R2 ;Is it a file? ;42 .iff BITB #FD.DIR,R0 ;Is it a file? .endc BEQ 10$ ;No, onward BIS #VF$FIL,V$FLAG(R4) ;A file, set bits ;37 BR 20$ ;And continue 10$: .if ne RMSIO $TESTBITS #FB$REC,DEV,R2 ;Record-oritented device? ;42 .iff BITB #FD.REC,R0 ;Record oriented device? ;32 .endc BEQ 20$ ;No, onward ;32 BIS #VF$REC,V$FLAG(R4) ;Record, no file. Flag same ;37 .if ne RMSIO $TESTBITS #FB$TRM,DEV,R2 ;Terminal? ;42 .iff BITB #FD.TTY,R0 ;True terminal? .endc BEQ 20$ ;No, continue BIS #VF$TTY,V$FLAG(R4) ;Yes, flag it ;37/38/39+/40 mov stderr,r0 ; R0 --> stderr ; ; Check if the file is being opened to the same device/unit as ; stderr. If so, indicate the file is open to the "console" ; by setting VF$CMD (command terminal). ; .if ne RMSIO ; ;42+ ; The following departs from the RMS macro conventions for ; obvious reasons. The assembler does the dirty work of ; calculating the address. ; cmp V$NAM+O$DVI(r4),V$NAM+O$DVI(r0) ; Same name? bne 20$ ; Branch if different devices cmp V$NAM+O$DVI+2(r4),V$NAM+O$DVI+2(r0); Same unit? bne 20$ ; No, its not the console ;42- .iff cmp V$FDB+F.FNB+N.DVNM(r4),V$FDB+F.FNB+N.DVNM(r0) ; Same name? bne 20$ ; Branch if different devices cmp V$FDB+F.FNB+N.UNIT(r4),V$FDB+F.FNB+N.UNIT(R0) ; Same unit? BNE 20$ ; (nope, not console) .endc BIS #VF$CMD,V$FLAG(r4) ; Mark opening the console in iov ;39- 20$: ;; NOTE: the record buffer is allocated by the first call to getch() ;37+ ;; this allows the user to allocate his own buffer by calling setbuf() ;; BIT #VF$NBF,V$FLAG(R4) ;User doing buffering? ;37 ;; BNE 30$ ;Yep, don't get buffer ;; MOV V$RBSZ(R4),R0 ;Record buffer size ;; INC R0 ;Just in case 'n' given ;; CALL $$FALO ;Go for it -- note: if this fails, $$fcls ;; ;will close the file. ;; MOV R0,V$RBUF(R4) ;Set the first buffer ;; MOV R0,V$BPTR(R4) ;and set free byte pointer ;37- 30$: MOV R4,R0 ;Return iov pointer JMP CRET$ ;And exit C-style .iff ;03+ ; ; RT11 file open ; .even ; .psect c$code ; freope:: jsr r5,csv$ ; Establish linkage mov C$PMTR+4(r5),r4 ; Get IOV pointer mov r4,r0 ; Set r0 non-zero to call $$clos ; close the existing file br fopen1 ; continue at main sequence fopen:: jsr r5,csv$ ; Establish linkage clr r4 ; No buffer yet fopen1: ; Common code for fopen/freopen ;04 call $$flun ; Get a Unit (and IOV) call $$fopt ; Scan options string jmp $$fopa ; And go open the file. .endc ; ; ** $$FOPE ; ; Error exit from fopen routines. If r4 is non-zero, the iov it points ; to will be deallocated. ; ; Calling sequence: ; ; mov #IE.code,r0 ;Error code ; jmp $$fope ;Jump here to die. ; $$FOPE:: MOV R0,$$FERR ;Save error code TST R4 ;Have we allocated an I/O vector? BEQ 10$ ;No, just die. CLR R0 ;Yes, force "full close" CALL $$FCLS ;Clean out buffers 10$: CLR R0 ;Return NULL JMP CRET$ ;Exit. .end -h- fpar.mac Thu Jan 19 14:37:01 1984 FPAR.MAC;1 .title $$fpar Parse & Set up Blox RMS fopen .enabl lc .ident /RMS003/ ; ;+ ; ; Internal ; ; Index Parse file name argument for fopen/fwild (RMS-11) ; ; Usage ; ; mov iov,r4 ;r4 -> iov ; call $$fpar ;C$PMTR+0(r5) => file name ; ;file name is parsed and FAB/RAB etc. setup. ; ;r0-r3 random ; ;error: return to caller via $$fope ; ; Description ; ; Parse the file name argument, and dynamically create the ; RMS-11 specific blox (FAB, RAB, NAM block, DAT block & ; PRO block). Used on RSX/RMS-11 only. If possible, this ; routine establishes RMS-11 wildcard context. ; ; Bugs ; ;- ; ; Edit history ; 000001 ??-???-?? TTC Initial edit, after $$fcsi ; RMS001 13-Dec-83 RBD Many changes here. No edit trails. Will change ; to use $STORE & friends later. ; RMS002 17-Dec-83 RBD Cleaned up. $OPEN is tried even if $PARSE ; or $SEARCH fail here. ; RMS003 29-Dec-83 TTC Added test to see if we were called from fwild ; and if so don't do initial search here. ; .iif ndf rsx rsx = 1 ;Assume RSX11M .iif ndf rmsio rmsio = 0 ;Assume FCS-11 .if ne RSX .if ne RMSIO .MCALL $PARSE $SEARCH $FETCH $STORE $SET $COMPARE .psect c$data $$DFNA:: .ascii "SY:" ; (Maybe [USERFILES] on P/OS???) $$DFNS = .-$$DFNA .even FNMSIZ = 82. ;Filename size maximum ; ; ; ** $$FPAR ; ; Parse the file name and setup the FDB for the open ; ; Calling sequence: ; ; jsr r5,csv$ ;standard setup ; mov iov,r4 ;r4 -> io vector ; call $$fpar ;parse the file name ; ;return: r0 -> fdb ; ;r0-r3 have been destroyed ; ;(exit via $$fope on error) ; .psect c$code $$FPAR:: ; ; Set up the FAB & its XAB chain, RAB and parse the file ; name using the RMS PARSE MACRO. We are creating the ; blox on the fly here. ; MOV R4,R2 ;R2 --> IOV ADD #V$FAB,R2 ;R2 --> FAB MOV R4,R1 ;R1 --> IOV ADD #V$NAM,R1 ;R1 --> NAM block $STORE #FB$BID,BID,R2 ;Fill in ID & Length fields $STORE #FB$BLN,BLN,R2 $STORE R1,NAM,R2 ;Fill in name attributes block MOV #FNMSIZ,R0 ;R0 = File name size CALL $$FALO ;Allocate or die $STORE R0,ESA,R1 ;Fill in the expanded string buffer address $STORE #FNMSIZ,ESS,R1 ;Fill in expanded string buffer size MOV #FNMSIZ,R0 ;R0 = File name size CALL $$FALO ;Allocate or die $STORE R0,RSA,R1 ;Fill in the resultant string buffer address $STORE #FNMSIZ,RSS,R1 ;Fill in resultant string buffer size MOV R4,R0 ;R0 --> IOV ADD #V$DAT,R0 ;R0 --> DAT block $STORE R0,XAB,R2 ;Fill in date/time in XAB of FAB $STORE #XB$DAT,COD,R0 ;Fill in it's trademarks $STORE #XB$DTL,BLN,R0 MOV R4,R1 ;R1 --> IOV ADD #V$PRO,R1 ;R1--> PRO block $STORE R1,NXT,R0 ;Fill in protection XAB link $STORE #XB$PRO,COD,R1 ; Fill in its trademarks $STORE #XB$PRL,BLN,R1 $STORE #0,NXT,R1 ;End of XAB chain MOV R4,R1 ;R1 --> IOV again ADD #V$RAB,R1 ;R1 --> RAB $STORE #RB$BID,BID,R1 ; Fill in ID & Length Fields $STORE #RB$BLN,BLN,R1 $STORE R2,FAB,R1 ;Fill in FAB address in RAB $STORE #$$DFNA,DNA,R2 ;Fill in default string address $STORE #$$DFNS,DNS,R2 ;Fill in defaults string length MOV C$PMTR+0(R5),R1 ;R1 --> File name from caller $STORE R1,FNA,R2 ;Stuff file name address in FAB CLR R0 ;Count length of file name 10$: TSTB (R1)+ ;At null? BEQ 20$ ;If so r0 = file name size INC R0 ;Count the data byte BR 10$ ;keep trucking 20$: $STORE R0,FNS,R2 ;Stuff size into FAB ; ; If $PARSE/$SEARCH fails, may be a device rather than a file. In any ; case, we'll try the OPEN or CREATE and let it fail there if it ; needs to. To do this properly, we do not set FB$FID. ; $PARSE R2 ;Parse the file name, fill in NAM block $COMPARE #SU$SUC,STS,R2 ;Error? BNE 30$ ;(Yes) BIT #VF$WLD,V$WFLG(R4) ; (No), called from fwild()? ;03 BNE 40$ ; If so, return without searching ;03 $SEARCH R2 ;Complete the job as best we can $COMPARE #SU$SUC,STS,R2 ;Error? BNE 30$ ;(yes, let $OPEN or $CREATE try it) $SET #FB$FID,FOP,R2 ;Use everything we can from the NAM block BR 40$ ; ; $PARSE or $SEARCH failed -- release resultant string buffer ; 30$: $FETCH R1,NAM,R2 ; R1 --> NAM block $FETCH R0,RSA,R1 ; R0 --> Resultant string buffer CALL $$FREE ; Free it $STORE #0,RSA,R1 ; Clear the RSA field in NAM block 40$: CLR V$DNAM(R4) ;No need to save disk:[dir] for VMS ... RETURN ;all done for now 100$: $FETCH R0,STS,R2 ;Error in R0 JMP $$FOPE ;and exit. .endc .endc .END -h- fseek.mac Thu Jan 19 14:37:01 1984 FSEEK.MAC;1 .title fseek Reposition file pointer (seek) .iif ndf rsx rsx = 1 ;Assume rsx11m .iif ndf rmsio rmsio = 0 ;Assume FCS-11 .if ne rmsio .ident "RMS011" .iff .ident /000011/ .endc ; ;+ ; ; Index Reposition file pointer (seek) ; ; Usage ; ; fseek(iop, offset, param); ; FILE *iop; /* What device to seek */ ; long offset; /* New read position */ ; int param; /* Zero for abs. seek */ ; ; Description ; ; fseek() moves the file pointer to the indicated position. ; The position must have been returned by ftell() or equal ; zero for rewind. Param must be zero. The file/device must ; be seekable. ; ; fseek() returns zero if correct, EOF if an error occurs. ; If no error occurred, error and eof flags are reset. ; ; flseek() is an alternate entry with identical parameters ; and actions. ; ; Note that on RSX, fseek() can be used to open a file for ; update by a sequence such as: ; ; fd = fopen("file.nam", "a"); ; fseek(fd, 0L, 0); /* Rewind file */ ; ; If the file was opened on RSX using the 'n' mode switch, it will ; be opened using file attributes "fixed 512-byte records with ; no carriage control". The offset pointer is thus ; a virtual byte number and fseek may be used to freely reposition ; the file pointer. ; ; Bugs ; ; The RMS-11 version of this routine uses a hack to reposition the ; stream context for the open file. This approach may fail on later ; versions of RMS-11 (worked on V2). The "Internal Stream ID" field ; of the RAB (O$ISI) is really a pointer to the "IRAB", whose ; structure may be found by extracting the IRAOF$ macro from the ; RMS-11 macro library. A simple experiment revealed that the ; three "NRP" fields used herein can be crammed with new values ; to reposition the file a'la .POINT. Don't blame me ... (RBD) ; ;- ; ; Edit history ; 000001 13-Mar-80 MM Initial edit ; 000002 27-Jun-80 MM $$get returns -1 on error ; 000003 01-Aug-80 MM Track IOV change ; 000004 05-Mar-81 RBD Clear V$BCNT to force a new read ; 000005 17-Jun-81 RBD ... but only on RSX ; 000006 25-Aug-81 RBD Allow seek on writeable rsx files ; 000007 29-Jun-82 MM New library, use virtual byte pointer for rt11 ; 000008 03-Aug-82 MM Painfully dumb typo ; 000009 29-Sep-82 MM Changed buffer busy test ; 000010 08-Jun-83 RBD Don't clear V$BCNT (on RSX) if file open in ; "u" mode. Forces a spurious read. ; RMS011 01-Jan-84 RBD Add conditional support for RMS-11(V2) on RSX and ; (particularly) P/OS. It's a hack ... see 'bugs'. ; .if ne rmsio .mcall $fetch iraof$ iraof$ rms$l .endc .psect c$code flseek:: fseek:: jsr r5,csv$ mov c$pmtr+0(r5),r4 ;r4 -> iop mov #-1,r0 ;expect the worst tst c$pmtr+6(r5) ;parameter = 0? bne 40$ ;nope, die. ;07 .if ne rsx bit #vf$rec,v$flag(r4) ;will it seek? ;03/06/07 bne 40$ ;nope, can't seek. ;07 .if eq rmsio ;11 bit #vf$wrt,v$flag(r4) ;is it open for write/append ;06+/07 beq 5$ ;no, continue bisb #FD.INS,F.RACC+V$FDB(r4) ;yes, set "don't truncate" .endc ;11 5$: ;main sequence ;06- mov c$pmtr+2(r5),r1 ;r1 := high-order vbn mov c$pmtr+4(r5),r2 ;r2 := low-order vbn mov r2,r3 ;r3 := byte offset in block bic #^C777,r3 ;now it does mov #9.,r0 ;do a long shift 10$: asr r1 ;of the ror r2 ;long block dec r0 ;number bgt 10$ ; bit #vf$fil,v$flag(r4) ;File or device ;07 beq 20$ ;Br if device add #1,r2 ;File, make origin adc r1 ;1 20$: .if ne rmsio mov r4,r0 ; r0 --> IOV ;11+ add #v$rab,r0 ; r0 --> RAB $FETCH r0,ISI,r0 ; r0 --> Internal RAB mov r1,r$hnrp(r0) ; Cram MSW of new block number mov r2,r$lnrp(r0) ; Cram LSW of new block number mov r3,r$bnrp(r0) ; Cram new byte offset ;11- .iff mov r4,r0 ;r0 -> fdb add #v$fdb,r0 ;now it does call .point ;seek away .endc bit #vf$nbf,v$flag(r4) ; Open in "u" mode: ;10 bne 22$ ;(yes, don't force read!) ;10 clr v$bcnt(r4) ;force $$get to read the record ;04/05 22$: clr r0 ;Normal return ;07/10 .iff ; ; RT11 ; bit #vf$rec+vf$tty+vf$wrt,v$flag(r4) ;will it seek? ;03/07 bne 40$ ;not a chance ;07 ; ; Make sure there's a buffer to read into. ; tst v$base(r4) ;Already set a buffer? ;07+ bne 3$ ;yup. ;08 call $$abuf ;allocate a default buffer bcc 3$ ;continue if ok com r0 ;return -1 br 40$ ;and exit 3$: ;07- ; ; Since this is a stream i/o package, we don't bother to ; check the busy bit and flush the current buffer. ; mov c$pmtr+2(r5),r1 ;High order byte offset ;07+ mov c$pmtr+4(r5),r0 ;Low order byte offset mov r0,r3 ;Grab a copy bic #^C777,r3 ;r3 has buffer offset mov #9.,r2 ;Shift counter 5$: asr r1 ;Long shift ror r0 ; to locate the dec r2 ; block bgt 5$ ; number tst V$BCNT(r4) ; Is the buffer empty? ;09/07- beq 10$ ;Yes, always read inc r0 ;Check against current (i.e. next) block cmp r0,v$bnbr(r4) ;Trying to get the block that's in? beq 20$ ;Yes, skip the read dec r0 ;No, reget the correct number ; 10$: call $$get ;Go for it tst r0 ;ok return? bmi 40$ ;no, die. ;02 ; 20$: mov v$rbsz(r4),v$bcnt(r4) ;Setup free count sub r3,v$bcnt(r4) ;Load free count ;07+ add v$base(r4),r3 ;Load free pointer mov r3,v$bptr(r4) ;and put it away. ;07- ; .endc ; ; Normal return ; bic #vf$eor,v$flag(r4) ;Clear error and eof flags ;07 ; 40$: jmp cret$ ;back we go. .end -h- ftell.mac Thu Jan 19 14:37:01 1984 FTELL.MAC;1 .title ftell Get file position for subsequent seek .iif ndf rsx rsx = 1 ;Assume RSX .iif ndf rmsio rmsio = 0 ;Assume FCS .if ne rmsio .ident "RMS005" .iff .ident /000005/ .endc ; ;+ ; ; Index Get file position for subsequent seek ; ; Usage ; ; long ; ftell(iop); ; FILE *iop; /* What device to seek */ ; ; Description ; ; ftell() returns the position of the read/write pointer of ; the indicated file. This value may be fed back to the ; file system by calling fseek(). Note that the value is ; a pointer to the record, not a block or byte pointer. On RSX, ; the program should flush the current record before calling ftell(). ; (Flush() is a noop on RT11.) ; ; If reading lines of text, the correct sequence is: ; ; position = ftell(fd); ; if (fgets(buffer, sizeof buffer, fd) != EOF) { ; /* ; * 'position' locates the record ; * read by the call to fgets() ; */ ; } ; ; Make sure you declare ftell() ; ; extern long ftell(); ; ; If you do not, it will return garbage. ; ; Bugs ; ; On both systems, the value returned is the position of the file ; pointer (RFA), as a byte offset from the start of the file. ; Note, however, that on RSX systems the pointer is to the start ; of the current record. It is not necessarily the case that ; the start of a text line equates to the start of a record. ; RSX supports many file record formats, including Fortran, ; print_file and "unformatted" (with embedded control ; information). The latter files may have multiple text lines ; embedded in each record. This is handled internally by ; the formatted read routines (i.e., fgets() and getc()). ; On RSX, the only way to be certain of the exact record/line ; correspondance is to use the fget() and fput() functions. ; The T utility program (in the tools library) shows another ; method of handling this problem. ; ; On RSTS/E RT11 mode, ftell will not process "large" files ; (with more than 65535 blocks) correctly. ; ; The RMS-11 flavor of this routine uses an undocumented hack to ; obtain the stream position. I fail to understand why "they" ; didn't provide a counterpart to the FCS POINT/MARK pair. ; See the 'bugs' in FSEEK for more info. ;- ; ; Edit history ; 000001 13-Mar-80 MM Initial edit ; 000002 29-Jul-80 MM Nothing like debugging ; 000003 01-Aug-80 MM Track IOV change ; 000004 29-Jun-82 MM Newer library, new rt11 ftell ; RMS005 02-Jan-84 RBD Add conditional support for RMS-11 I/O, mainly ; for use on P/OS. It's a hack ... see 'bugs'. ; .if ne rmsio .mcall $fetch iraof$ iraof$ rms$l .endc .psect c$code ftell:: jsr r5,csv$ mov c$pmtr+0(r5),r4 ;r4 -> iop .if ne rsx ;01 .if ne rmsio mov r4,r0 ; r0 --> IOV ;05+ add #v$rab,r0 ; r0 --> RAB $FETCH r0,ISI,r0 ; r0 --> IRAB mov r$hnrp(r0),r1 ; r1 = MSW of VBN mov r$lnrp(r0),r2 ; r2 = LSW of VBN mov r$bnrp(r0),r3 ; r3 = next byte in block ;05- .iff mov r4,r0 ;r0 -> fdb add #v$fdb,r0 ;now it does call .mark ;Get fcs position: ;r1 high-order bits of vbn ;r2 low-order bits of vbn ;r3 next byte in this block .endc bit #vf$fil,v$flag(r4) ;A file device? ;04 beq 10$ ;no, a true disk sub #1,r2 ;fix block number sbc r1 ;both halves. 10$: .iff ;04+ clr r1 ;(No high-order block number) tst v$bptr(r4) ;Live buffer? bne 5$ ;Br if so. clr r0 ;Nope, empty file is at [0,0] br 30$ ;take common exit 5$: mov v$bptr(r4),r3 ;Get offset to sub v$base(r4),r3 ;current free byte. mov v$bnbr(r4),r2 ;Here's the low-order block number bit #VF$WRT,v$flag(r4) ;Writing? bne 10$ ;yes, got the right block dec r2 ;reading -- block is off by 1 10$: .endc ;04- mov #9.,r0 ;shift 20$: asl r2 ;vbn rol r1 ;left dec r0 ;nine bgt 20$ ;bits add r3,r2 ;Then add in byte pointer adc r1 ;Both halves. mov r1,r0 ;return a long mov r2,r1 ;in the right place. 30$: ;Jump here for RT11 rewind ;04 jmp cret$ ;and back we go. .end -h- fwild.mac Thu Jan 19 14:37:01 1984 FWILD.MAC;1 .title fwild Wild-card file open .ident /000017/ ; ;+ ; ; Index Wild-card file open ; ; Usage ; ; FILE * ; fwild(name, mode); ; char *name; /* File to open */ ; char *mode; /* Open modes */ ; ; FILE * ; fnext(iop); ; FILE *iop; /* I/O pointer */ ; ; Description ; ; Fwild() opens a new or existing file (whose file name may ; contain "wild-cards"). Open modes are identical to those ; given in fopen(). On return, the file name has been parsed, ; but no file has yet been opened. A NULL return means that ; the file name did not parse correctly. ; ; Fnext() opens the first or next file which was defined ; by a previous call to fwild(). If fnext() returns NULL, there ; are no (more) files that match the wild-card specification. ; ; fwild/fnext handle RSX file version numbers correctly on ; VMS compatibility mode (which uses the ODS2 disk structure). ; Fwild/fnext do not handle version numbers correctly on ; native RSX systems which use the FILES-11 (ODS1) disk structure. ; For example, a program can request "foo.*;3", "foo.*;*", "foo.*;0", ; and "foo.*;-1". Omitting a version number "foo.*" is equivalent ; to "foo.*;0". Note that version number 0 means the "newest" file, ; while version number -1 means the oldest. (Version numbers are ; not used on RT11 or RSTS/E.) ; ; For native RSX systems (using the FILES-11 disk structure), an ; explicit version number and the wildcard version number work ; correctly. Version numbers 0 and -1 work only if the directory has ; been reorganized by using the SRD utility program. If the directory ; has not been reorganized (such that the youngest version appears ; first in the directory), fnext() will yield unpredictable results. ; ; On RT-11, the wildcard filename match is handled internally ; to fwild/fnext. The parser will handle several forms of wild ; file specs, including imbedded '*' and the single character ; wildcard '%', and acts the same as the DIRECTORY wildcard handler. ; For convenience, a '?' acts the same as a '%' in a match string. ; ; Note: if a program executes fclose(), all file name information ; will be lost. The following sequence illustrates proper use ; of fwild()/fnext(): ; ; if (gets(name_buff) == NULL) ; exit(); ; if ((fd = fwild(name_buff, "r")) == NULL) ; error("Can't open %s\n", name_buff); ; for (count = 0; fnext(fd) != NULL; count++) { ; /* ; * Process each file ; */ ; while (fgets(buffer, sizeof buffer, fd) ; != NULL) { ; /* ; * Process each record ; */ ; } ; } ; /* ; * fnext() fails; the channel is closed. ; * count has the number of files processed. ; */ ; if (count == 0) ; error("No matching files found"); ; ; The following summarizes the types of wild-card processing ; available on the various implementations of the C support ; library: ; ; Environment Supports ; ; Native RSX "*" matches any filename, filetype, or ; version number. Version ;0 and ;-1 are ; supported on ODS2 systems. UIC's may ; not contain wildcards. ; ; RSX/VMS As above, note that version ;-1 means ; the "earliest" version. Note warning ; below. Directory identifiers may not be ; wildcarded. VMS systems support ODS2. ; ; RSX/RSTS Uses RSTS/E wildcard conventions: "*" ; replaces filename or filetype. "?" ; matches any character. PPN's may not be ; wildcarded. Version numbers are not ; supported on RSTS/E. ; ; Native RT11 "*" replaces any string, "%" or "?" ; match any non-blank character. ; ; RT11/RSTS Uses RSTS/E wildcard conventions noted ; above. ; ; Bugs ; ; On native RSX systems using ODS1 (FILES-11) disk structures, ; version numbers will be processed properly only if directories ; have been sorted (by using the SRD utility program, for example). ; If directories are not sorted, and fwild() is invoked with version ; number ;0 or ;-1, it will yield unpredictable results. ; ; The command language scan (CSI1$) on VMS compatibility mode does ; not parse version number -1 (because it has a different meaning ; on native VMS) and fwild() will consequently fail. ; ; If you want the oldest version, fwild() should be invoked with ; a file name of the type "foo.*" or "foo.*;0" and, before calling ; fnext() for the first time, you should set the correct bits in ; the IOV flag word as follows: ; ; if ((fd = fwild(file, "r")) == NULL) ; error("can't open file %s", file); ; if ((fd->io_flag & IO_VER) != 0 ; && version_minus_1_wanted) ; fd->io_flag |= IO_VM1; ; ; Flag bit IO_VER signals "version 0 or -1", while bit IO_VM1 ; signals version minus 1. Again, note that this must be done ; before the first call to fnext(). ; ; On native RT11 and all RSTS/E modes, fwild/fnext will fail ; if the device is not directory structured (even if no wildcard ; file is specified). If this is a problem, you should write: ; ; if ((fd = fwild(filename, mode)) != NULL) ; iswild = 1; ; else if ((fd = fopen(filename, mode) != NULL) ; iswild = 0; ; else error("cannot open the file"); ; ; The program must then test iswild to determine if it ; must call fnext() or if processing should be initiated ; directly. ; ; On all RSTS/E modes, there may be problems with logical name ; translation as file name strings must be parsed more than once. ; Thus, if a programer defines a logical name which is identical ; to a valid physical device name, a wildcard lookup may access ; the wrong unit. This problem is described in the RSTS/E ; documentation. ; ; Fwild/fnext was designed to work only with disk devices. It ; will not necessarily work correctly with other directory-structured ; devices, such as magtape. ; ; Internal ; ; If you are always running on RSTS/E, or always running ; on RSX-11 (native or VMS compatibility mode) or always running ; on native RT11, you should consider editing fwild.mac to remove ; unnecessary code. ; ; This routine depends on some internal knowledge about RSTS/E ; and about the implementation of RSX-11 file control services on ; RSTS/E. It may need modification for subsequent releases ; of RSTS/E. ; ; The implementors do not apologize for the size of this module. ; ; The distribution of the C language system includes source code ; for the SRD (sort directories) utility program. ; ;- ; ; Edit history ; 000001 10-Jun-80 MM Initial edit ; 000002 26-Jun-80 MM Added RSTS/E support ; 000003 28-Jul-80 MM Changed F.DID and F.STAT to F.FNB+N.????N ; 000004 01-Aug-80 MM Use VF$WF1 for first flag (instead of VF$OPN) ; 000005 01-Aug-80 MM RSTS definitions eat much .asect space. Redone ; 000006 18-Aug-80 RBD Added native RT11 support, affects fopen, and iov. ; 000007 25-Aug-80 MM Added RSTS/RT11 support. Hacked code considerably, ; including implemetation of the DIRECTORY match ; algorithm. Edit codes are not always present. ; 000008 16-Sep-80 MM RSTS/RSX sets V$UIC word from the firqb ; 000009 18-Sep-80 MM Fixed .psect name ; 000010 23-Sep-80 MM Clear error code before exit if no wild on RT11 ; 000011 24-Sep-80 MM Corrected RSTS/RT .FSS call for logical devices ; 000012 25-Sep-80 MM Explicitly clear out IOV for RT11 fnext ; 000013 15-Oct-80 MM Clear EOF/ERR flag before opening, clear fnext return ; 000014 27-Feb-81 MM Handle RSX "next file" for privilege and lock errors ; 000015 29-Jun-82 MM Newer library ; 000016 28-Dec-82 TTC Fixed several RT-11 bugs. ; 000017 29-Dec-83 TTC Added RMS support. ; .iif ndf rsx rsx = 1 ;Assume RSX11M .iif ndf l$$ist l$$ist = 0 ;Supress listings .iif eq l$$ist .nlist ; ; The following must track RSTS/E COMMON.MAC ; .MACRO .DSECT START,CREF .IIF B , .DSABL CRF $$$$$$ = 0 .IIF B , .ENABL CRF .IF NB $$$$$$ = START .ENDC .ENDM .DSECT .MACRO WORD WHAT,N .IIF NB WHAT = $$$$$$ .IF NB $$$$$$ = $$$$$$+<2*N> .IFF $$$$$$ = $$$$$$+2 .ENDC .ENDM WORD .MACRO BYTE WHAT,N .IIF NB WHAT = $$$$$$ .IF NB $$$$$$ = $$$$$$+N .IFF $$$$$$ = $$$$$$+1 .ENDC .ENDM BYTE ; ; TRANSFER CONTROL BLOCK (XRB) ; USED BY USER TO INITIATE AN I/O REQUEST ; AND FOR MONITOR/USER DATA REQUESTS. .DSECT ,NOCREF WORD XRLEN ;LENGTH OF I/O BUFFER IN BYTES WORD XRBC ;BYTE COUNT FOR TRANSFER WORD XRLOC ;POINTER TO I/O BUFFER BYTE XRCI ;CHANNEL NUMBER TIMES 2 FOR TRANSFER BYTE XRBLKM ;RANDOM ACCESS BLOCK NUMBER (MSB) WORD XRBLK ;RANDOM ACCESS BLOCK NUMBER (LSB) WORD XRTIME ;WAIT TIME FOR TERMINAL INPUT WORD XRMOD ;MODIFIERS XRBSIZ = $$$$$$ ;SIZE OF THE XRB IN BYTES ; ; ; FILE REQUEST QUEUE BLOCK (FIRQB) (PRONOUNCED 'FURK-BE') ; ALL REQUESTS FOR FILE PROCESSING ARE MADE BY SETTING THE NECESSARY PARAMETERS ; IN THE FIRQB, AND CALLING THE MONITOR WITH "CALFIP". .DSECT ,NOCREF BYTE ;RESERVED FOR RETURNED ERROR CODE BYTE ;RESERVED BYTE BYTE FQJOB ;HOLDS YOUR JOB NUMBER TIMES 2 BYTE FQFUN ;FUNCTION REQUESTED BYTE FQERNO,0;ERROR MESSAGE CODE AND TEXT BEGIN BYTE FQFIL ;CHANNEL NUMBER TIMES 2 BYTE FQSIZM ;FILE SIZE IN BLOCKS (MSB) WORD FQPPN ;PROJECT-PROGRAMMER NUMBER WORD FQNAM1,2;2 WORD FILENAME IN RADIX 50 WORD FQEXT ;.EXT IN RADIX 50 WORD FQSIZ ;FILE SIZE IN BLOCKS (LSB) WORD FQNAM2,0;3 WORD NEW FILENAME.EXT IN RADIX 50 WORD FQBUFL ;DEFAULT BUFFER LENGTH WORD FQMODE ;MODE INDICATOR WORD FQFLAG ;OPENED FILE'S FLAG WORD AS RETURNED BYTE FQPFLG ;"PROTECTION CODE REAL" INDICATOR BYTE FQPROT ;NEW PROTECTION CODE WORD FQDEV ;2 BYTE ASCII DEVICE NAME BYTE FQDEVN ;1 BYTE UNIT NUMBER BYTE ;"UNIT NUMBER REAL" INDICATOR WORD FQCLUS ;FILE CLUSTER SIZE FOR FILE CREATES WORD FQNENT ;NUMBER OF ENTRIES ON DIRECTORY LOOKUP FQBSIZ = $$$$$$ ;SIZE OF THE FIRQB IN BYTES ; MONITOR CALLS (EMT'S) .DSECT +EMT,NOCREF WORD CALFIP ;CALL FIP, WITH FIRQB LOADED WORD .READ ;READ WORD .WRITE ;WRITE WORD .CORE ;CHANGE USER MEMORY SIZE WORD .SLEEP ;SLEEP JOB FOR N SECONDS WORD .PEEK ;PEEK AT MEMORY WORD .SPEC ;SPECIAL FUNCTION WORD .TTAPE ;ENTER TAPE MODE WORD .TTECH ;ENABLE ECHO WORD .TTNCH ;DISABLE ECHO WORD .TTDDT ;DDT SUBMODE WORD .TTRST ;CANCEL ^O EFFECT WORD .TIME ;GET TIMING INFORMATION WORD .POSTN ;GET DEVICE'S HORIZONTAL POSITION WORD .DATE ;GET CURRENT DATE & TIME WORD .SET ;SET KEYWORD BIT(S) WORD .STAT ;GET MY STATISTICS WORD .RUN ;RUN A NEW PROGRAM WORD .NAME ;INSTALL A NEW PROGRAM NAME WORD .EXIT ;EXIT TO DEFAULT RUN-TIME SYSTEM WORD .RTS ;CHANGE TO A NEW RUN-TIME SYSTEM WORD .ERLOG ;LOG AN ERROR FROM THE RUN-TIME SYSTEM WORD .LOGS ;CHECK FOR LOGICAL DEVICES WORD .CLEAR ;CLEAR KEYWORD BIT(S) WORD .MESAG ;MESSAGE SEND/RECEIVE WORD .CCL ;CCL CHECKER WORD .FSS ;FILE STRING SCANNER WORD .UUO ;UUO HOOK WORD .CHAIN ;CHAIN TO A NEW PROGRAM WORD .PLAS ;RESIDENT LIBRARY CONTROL WORD .RSX ;ENTER RSX EMULATION WORD .ULOG ;ASSIGN/REASSIGN/DEASSIGN DEVICE/USER LOGICAL ; FIP (FIRQB @ FQFUN) FUNCTION CODES .DSECT ,NOCREF WORD CLSFQ ;CLOSE AN OPEN CHANNEL WORD OPNFQ ;OPEN A CHANNEL WORD CREFQ ;CREATE/EXTEND/OPEN A CHANNEL WORD DLNFQ ;DELETE A FILE BY NAME WORD RENFQ ;RENAME A FILE WORD DIRFQ ;DIRECTORY INFORMATION WORD UUOFQ ;PROCESS UUO WORD ERRFQ ;GET ERROR MESSAGE TEXT WORD RSTFQ ;RESET (CLOSE) [ALL] CHANNEL[S EXCEPT 0] WORD LOKFQ ;LOOKUP A FILE WORD ASSFQ ;ASSIGN A DEVICE WORD DEAFQ ;DEASSIGN A DEVICE WORD DALFQ ;DEASSIGN ALL DEVICES WORD CRTFQ ;CREATE/EXTEND/OPEN A UNIQUE .TMP FILE ON DISK WORD CRBFQ ;CREATE/EXTEND/OPEN A COMPILED IMAGE FILE ON DISK FIRQB = 402 XRB = 442 ;05- ; ; l$$rsts has the following values: ; 1 Compile RSTS/E specific code only ; 2 Compile native mode specific code only ; 3 Compile both flavors of code ; .iif ndf l$$rsts l$$rsts = 3 ;Compile all flavors .macro rsts.. ; Compile RSTS/E specific code .if ne l$$rsts&1 .endm .macro native.. ; Compile native-only modes .if ne l$$rsts&2 .endm .macro both.. ; Compile if both modes desired .if eq l$$rsts-3 .endm .macro ..revert ; End of condiditional compilation .endc .endm .iif eq l$$ist .list ; ; ; N o t e ; ; This code has only been tested using l$$rsts set to 3 ; ; Any instances of rsts.., native.., both.., and ..revert ; are indications only. ; .MACRO PRINTF FMT,A1,A2,A3,A4,A5,A6,A7,A8,A9,?FORMAT,?EXIT MOV R0,-(SP) MOV R1,-(SP) $$$$$$ = 4 .IF NB A9 MOV A9,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A8 MOV A8,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A7 MOV A7,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A6 MOV A6,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A5 MOV A5,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A4 MOV A4,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A3 MOV A3,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A2 MOV A2,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A1 MOV A1,-(SP) $$$$$$ = $$$$$$+2 .ENDC MOV #FORMAT,-(SP) MOV STDERR,-(SP) CALL FPRINTF ADD #$$$$$$,SP MOV (SP)+,R1 MOV (SP)+,R0 ; ; Note: on RT11 Version 4, you can use the .SAVE and .RESTORE compiler ; directives to switch to the $strn PSECT as follows: ; ; .SAVE ; .psect c$strn ; FORMAT: .ASCII FMT ; .BYTE 12,0 ; .EVEN ; .RESTORE ; ; This doesn't compile on RSTS/E, however. ; BR EXIT FORMAT: .ASCII FMT .BYTE 12,0 .EVEN EXIT: .ENDM PRINTF .MACRO NOTE TEXT,?TLOC,?EXIT mov r0,-(sp) mov #tloc,r0 call $$msg mov (sp)+,r0 ; ; Note: on RT11 Version 4, you can use the .SAVE and .RESTORE compiler ; directives to switch to the $strn PSECT as follows: ; ; .SAVE ; .psect c$strn ; TLOC: .ASCIZ TEXT ; .EVEN ; .RESTORE ; ; This doesn't compile on RSTS/E, however. ; br exit tloc: .asciz text .even EXIT: .ENDM NOTE ; .list meb .if ne rsx .if ne RMSIO .mcall $FETCH $SEARCH $COMPARE $TESTBITS $SET .iff .mcall FDOF$L, NBOF$L FDOF$L NBOF$L .endc ; .psect c$data .even ; .psect c$code ; ; Parse the name and setup the tables ; ; Note the following special cases: ; foo.* == foo.*;0 ; foo.*;0 Find latest version only ; foo.*;-1 Find earliest version only ; foo.*;3 Find version 3 only ; foo.*;* Find all versions ; ; Note: although the RSX documentation mentions ";-1" versions, ; they get an error from CSI$1 on VMS emulation (and no versions ; work on RSTS). ; ; Bits are set in V$FLAG as follows: ; VF$VER set if ;0 or ;-1 ; VF$VM1 set if version = -1 ; fwild:: jsr r5,csv$ ; Link environments clr r4 ; No IOV yet call $$flun ; Get a LUN call $$fopt ; and scan options .if eq RMSIO both.. ;02+ tst $$rsts ; Running on RSTS/E? beq docsi ; Br if not, do standard setup ..revert rsts.. ; ; Do a RSTS csi scan -- if no wildcards, just do standard setup ; mov #FIRQB,r0 ; Setup to clear 10$: clr (r0)+ ; Clear the FIRQB cmp r0,#XRB+XRBSIZ ; and the blo 10$ ; XRB mov C$PMTR+0(r5),(sp) ; Get the file name call strlen ; Get it's length mov r0,@#XRB+XRLEN ; Stuff in XRB mov r0,@#XRB+XRBC ; Both places mov C$PMTR+0(r5),@#XRB+XRLOC ; Stuff file name .FSS ; File name string scan tstb @#FIRQB ; Error? bne docsi ; If so, let standard scan die mov @#XRB+10,r0 ; "flag word 2" bit #1400,r0 ; Wild p,pn ? bne docsi ; Yes, die (we can't lookup [*,]) bit #146,r0 ; Anything wild (name or ext) beq docsi ; No, do it the easy way mov #FQBSIZ,r0 ; Allocate a call $$falo ; Wild card block mov r0,V$WILD(r4) ; Stuff it away mov r0,r2 ; Save a copy mov #FIRQB,r1 ; r1 -> firqb 20$: mov (r1)+,(r0)+ ; Save firqb cmp r1,#FIRQB+FQBSIZ ; all of blo 20$ ; it. movb #LOKFQ,FQFUN(r2) ; We'll use the lookup function mov #-1,FQERNO(r2) ; Initialize "current file number" bis #VF$WLD,V$WFLG(r4) ; Set wild-card bit for fnext() ;07/15 mov FIRQB+FQPPN,V$UIC(r4) ; Save Directory ID ;08 br wexit ; Normal exit ..revert .endc docsi: MOV C$PMTR+0(R5),-(SP) ;Push File name from caller .if ne RMSIO ;18+ ; ; Set the wild flag prior to calling fpar. Fpar ; checks this flag to see if the call was from ; fwild and if so the first file is not opened until ; fnext is called. ; bis #VF$WLD,V$WFLG(r4) ; Set wild flag for FPAR call $$fpar ; Parse the file name mov r4,r2 ; r2 -> iov add #V$FAB,r2 ; r2 -> FAB $FETCH r1,NAM,r2 ; r2 -> NAM block $TESTBITS #NB$WCH,FNB,r1 ; Anything wild to do? bne wexit ; (Yes), wild flag is already set bic #VF$WLD,V$WFLG(r4) ; Nothing wild clear wild flag br wexit ; do no more here .iff ;18 call $$fcsi ; Do CSI scan and setup fdb/fnb, too mov r4,r2 ; r2 -> IOV add #V$FDB+F.FNB+N.STAT,r2 ; r2 -> file name block status bits bit #NB.SNM+NB.STP+NB.SVR,(r2) ; Anything wild? ;07 beq wexit ; If not do nothing ;02 bis #VF$WLD,V$WFLG(r4) ; Something wild to do ;07/15 native.. ;15 bit #NB.SVR,(r2) ; Wild card version specified? bne wexit ; yes, do no more here ;02 bit #NB.VER,(r2) ; Version specified by caller bne 10$ ; Branch if so bis #NB.VER,(r2) ; None specified, force clr V$FDB+F.FVER(r4) ; version 0 (last) 10$: mov V$FDB+F.FVER(r4),r0 ; Get version beq 20$ ; Br if version is zero inc r0 ; Not zero, is it -1 bne wexit ; Br if not minus 1 ;02 bis #VF$VM1,V$WFLG(r4) ; Set "version -1" flag ;15 20$: bis #VF$VER,V$WFLG(r4) ; Set version hacking flag ;15 bis #NB.SVR,(r2) ; Force "find any version" in FDB ..revert .endc wexit: ;02 mov r4,r0 ; All right so far jmp cret$ ; Back to the caller ; ; Now open the (next) file. Note that the algorithm depends on the ; fact that the C library cleans up the stack before returning to ; the calling program. ; fnext:: jsr r5,csv$ ; Link environments mov C$PMTR+0(r5),r4 ; r4 -> IOV mov r4,r1 ; r1 -> iov .if ne RMSIO add #V$FAB,r1 ; r1 -> FAB bit #VF$WF1,V$WFLG(r4) ; Has it been opened yet? bne 10$ ; Br if so (flag set) ; ; First call of fnext for this file specification ; bis #VF$WF1,V$WFLG(r4) ; Set flag for next time bit #VF$WLD,V$WFLG(r4) ; Anything wild? bne fwfind ; Br if a wild-card file jmp $$fopn ; Do normal open, instead. ; ; Close out the currently opened file ; 10$: mov r4,r0 ; Make r0 non-zero call $$clos ; Close out the file, keep IOV bit #VF$WLD,V$WFLG(r4) ; Anything wild? beq nomore ; No wild card, just exit ; ; Ready to find the file. ; fwfind: $SEARCH r1 ; Get next file $COMPARE #SU$SUC,STS,r1 ; Error? beq okexit ; (no), go open the file ; ; No more files to be found ; nomore: $FETCH r1,STS,r0 ; Error return from $SEARCH cmpb #ER$NMF,r0 ; "No more matching files"? bne badend ; No, a real error clr r0 ; Yes, an expected error badend: jmp $$fope ; Clean up and exit ; ; Normal exit -- go open the file ; okexit: bic #VF$ERR!VF$EOF,V$FLAG(r4) ; Make sure no end of file $SET #FB$FID,FOP,r1 ; Set FIB mask to preserve wild context call $$fopo ; $$fopo doesn't return if ok cmpb #ER$PRV,R0 ; But if it's "no access", beq fwfind ; try for another. cmpb #ER$FLK,r0 ; Or if it's "file locked", beq fwfind ; try for another. br badend ; So die already. .iff add #V$FDB+F.FNB,r1 ; r1 -> file name block mov N.STAT(r1),r2 ; r2 = N.STAT clr r3 ; flag first/next call bit #VF$WF1,V$WFLG(r4) ; Has it been opened yet? ;03/15 bne 10$ ; Br if so (flag set) ; ; First call of fnext for this file specification ; bis #VF$WF1,V$WFLG(r4) ; Set flag for next time ;03/15 inc r3 ; This is the first call bit #VF$WLD,V$WFLG(r4) ; Anything wild? ;07/15 bne fwfind ; Br if a wild-card file ;14 jmp $$fopn ; Do normal open, instead. ; ; Close out the currently opened file ; 10$: mov r4,r0 ; Make r0 non-zero call $$clos ; Close out the file, keep IOV bit #VF$WLD,V$WFLG(r4) ; Anything wild? ;07/15 beq nomore ; No wild card, just exit ; ; Ready to find the file ; fwfind: ;14 mov r4,r0 ; r0 -> iov add #V$FDB,r0 ; r0 -> fdb rsts.. ;02+ mov V$WILD(r4),r3 ; RSTS wild card handling? bne rsnext ..revert native.. ;02- bit #VF$VER,V$WFLG(r4) ; Version number hacking? ;15 beq nfind ; Br if normal (specific or all) bit #VF$VM1,V$WFLG(r4) ; Version -1 ;15 bne 40$ ; Br if so ; ; The algorithms for Version 0 and Version -1 depend on the fact ; that ODS2 stores the youngest version (highest version number) ; first in the directory: "foo.bar;3 foo.bar;2 foo.bar;1" ; ; Version 0 ; ; If this is the first time (there's no current file), just find ; any file. Else, save the current file name and ; do read next file (error -> no more files) ; while file names are the same ; tst r3 ; First time through? bne nfind ; Yes, just get something mov N.FTYP(r1),-(sp) ; Save file type (extension) mov N.FNAM+4(r1),-(sp) ; and the mov N.FNAM+2(r1),-(sp) ; file mov N.FNAM+0(r1),-(sp) ; name ; ; The stack is now: ; 0 file name ; 2 file name ; 4 file name ; 6 file type ; 30$: call .find ; Look for something bcs nomore ; Out of the loop if no more call test ; Is it the same? beq 30$ ; Keep on trying bne okexit ; New file if no match br 30$ ; keep on trying ; ; Version -1 ; ; Find the next file, then find the last version with this name ; 40$: mov N.NEXT(r1),r2 ; Save pointer to next file call .find ; Find a file bcs nomore ; Exit if there aren't any mov N.FTYP(r1),-(sp) ; Save file type (extension) mov N.FNAM+4(r1),-(sp) ; and the mov N.FNAM+2(r1),-(sp) ; file mov N.FNAM+0(r1),-(sp) ; name 50$: mov r2,r3 ; Save pointer to current file mov N.NEXT(r1),r2 ; Save pointer to next file call .find ; Try for another file bcs 60$ ; Exit loop at end call test ; Got a match? beq 50$ ; continue while we do 60$: mov r3,N.NEXT(r1) ; Restuff the NEXT indicator mov (sp)+,N.FNAM+0(r1) ; and mov (sp)+,N.FNAM+2(r1) ; the mov (sp)+,N.FNAM+4(r1) ; file mov (sp)+,N.FNAM+6(r1) ; name ..revert ;02 ; ; Find any file (here for specific versions, or any version) ; nfind: call .find ; Find next file bcc okexit ; Br if found one ; ; No more files to be found ; nomore: movb F.ERR(r0),r0 ; Error return from .find cmpb #IE.NSF,r0 ; "No such file" bne badend ; No, a real error clr r0 ; Yes, an expected error badend: jmp $$fope ; Clean up and exit ; ; Normal exit -- go open the file ; okexit: bic #VF$ERR!VF$EOF,V$FLAG(r4) ; Make sure no end of file ;13/15 call $$fopo ; No return if ok ;14+ cmpb #IE.PRI,R0 ; But if it's "no access", beq fwfind ; try for another. cmpb #IE.LCK,F.ERR(r0) ; Or if it's "file locked", beq fwfind ; try for another. br badend ; So die already. ;14- .page native.. ;02 ; ; Test for a file name match ; ; Entry: ; ; r1 -> file name block ; 0(sp) return address ; 2(sp) file name start ; ; Return: condition codes setup for test (beq if match, bne if no match) ; test: cmp N.FNAM+0(r1),2(sp) ; Check for a file match bne 10$ ; Found cmp N.FNAM+2(r1),4(sp) ; a bne 10$ ; new cmp N.FNAM+4(r1),6(sp) ; file bne 10$ ; if cmp N.FTYP(r1),10(sp) ; mismatch 10$: return ; Return, condition codes setup ..revert ;02+ rsts.. ; ; Find the next file on RSTS/E. Note that we do all the firqb stuff ; ; This routine depends on some internal knowledge about the RSTS/RSX ; implementation. It may need modification for subsequent releases ; of RSTS/E. ; ; ; On entry, ; r0 -> fdb ; r1 -> fdb @ fnb ; r3 -> Wild card buffer (firqb after .fss call) ; rsnext: inc FQERNO(r3) ; Increment lookup count mov #FIRQB,r2 ; R2 -> firqb 10$: mov (r3)+,(r2)+ ; Copy firqb cmp r2,#FIRQB+FQBSIZ ; Until blo 10$ ; It's done CALFIP ; Do it tstb @#FIRQB ; Did it work? beq 15$ ; Yes, continue ;14+ movb #IE.NSF,F.ERR(r0) ; No, fake "no more files" br nomore ; Take normal exit 15$: ; ;14- ; ; Gotcha, setup file name block ; mov r1,r2 ; Another copy of the name block add #S.FNB,r2 ; r2 -> end of name block 20$: clr (r1)+ ; Clear out the cmp r1,r2 ; file name blo 20$ ; block bis #NB.SVR,F.FNB+N.STAT(r0) ; reset "wild card" flag mov #FIRQB+FQPPN,r2 ; r2 -> FQPPN mov (r2)+,F.FNB+N.DID(r0) ; Save UIC mov (r2)+,F.FNAM(r0) ; and name mov (r2)+,F.FNAM+2(r0) ; and the mov (r2)+,F.FTYP(r0) ; extension mov @#FIRQB+FQDEVN,F.UNIT(r0) ; Device unit clrb F.UNIT+1(r0) ; Clear "is real" flag in fdb ; ; Note, the following bit of hackery is needed as, if no device name ; is given, FCS will use the "assigned LUN device" from link time. ; Since the C library assigns channels as they are used, something must ; be present, else disaster will strike. ; mov @#FIRQB+FQDEV,F.DVNM(r0) ; Device name bne okexit ; Br if there is one mov #"SY,F.DVNM(r0) ; No device given, force clr F.UNIT(r0) ; system disk br okexit ; Go find it ..revert .endc .iff ; ; RT-11 wild file processing: ; ; Since native RT-11 has no intrinsic wildcard support, fwild() must do ; the lexical analysis and parsing of the supplied wild filespec string ; to produce a match template for the directory search. See the comments ; local to the "expand" subroutine for more on this. ; ; In order to simultaneously accommodate more than one wild file process, ; the state information for the wild processing is stored in a "wild ; data block" pointed to by the V$WILD field in the iov. Typically ; r4 is used to point to the iov, and r3 to point to the "wdb". ; It looks like this: (In fact it's defined here too) W.NSIZ = 12. ; Longest match pattern (with NULL trail) .DSECT ; Wild file data block: ; ** Order-dependent data ** WORD W.DEV ; ** Device name in RAD50 BYTE W.NAME,W.NSIZ ; ** "ABCDEF GHI <0>" ; ** End of order-dependent data ** WORD W.CHST,5. ; .SAVESTATUS area WORD W.DSEG ; Current directory segment WORD W.DENT ; Next entry to search WORD W.ESIZ ; Size of directory entry in bytes WDBSIZ = $$$$$$ ; Size of WDB in bytes ; The iov and the wdb are set up on the call to fwild(). The iov is ; extended by 512. bytes so that the buffer may be easily used for ; directory operations as well as file access. Part of fopen() is used to ; open the directory. Any but a directory device is rejected. A .SAVESTATUS ; keeps the directory channel context in the wdb. Then the directory ; is closed. ; ; On a call to fnext(), any open file is closed. The directory is ; .REOPEN'ed and the current segment read into the data buffer. The ; directory is then searched starting with the first entry not yet ; checked for match. Additional segments are read in as required until ; a matching file is found or the end of the directory is reached. The ; directory channel is closed and the matching file, if any, is opened. ; fwild() ; Get a LUN and iov ; Extend iov by 512. bytes so buffer holds 512. words ; If extend failed ; error(E$$NSP) { No memory } ; Get a wild data block and hook to iov ; Scan filename for device spec ; If devspec given ; Convert to RAD50 ; Copy devspec to wdb ; else ; Copy default devspec to wdb ; Do a non file structured open on device. ; If device not directory device ; error(E$$NOD) { Not valid device } ; else ; savestatus on directory ; expand filename/type into wild match template --> wdb ; If expand error ; error(E$$ILF) { Illegal file name } ; else (expanded OK) ; scan options string and set bits ($$fopt) ; initialize the directory next entry pointer to first entry loc. ; initialize the directory next segment link to 1 (segs start at 1) ; return pointer to iov ; .macro .priv ; This macro preceeds native RSTS/E EMT's emt 377 .endm .priv defdev = ^RDK ; *** Default Device *** .psect c$code ; ; Main entry point ; fwild:: jsr r5,csv$ ; Link environments clr r4 ; Need new iov... call $$flun ; ...so get it, assign LUN, etc. call $$fopt ; and get the options both.. tst $$rsts ; Running on RSTS/E beq fwild1 ; No, do native lookup ..revert rsts.. ; ; Do a RSTS/E csi scan ; mov C$PMTR+0(r5),r0 ; R0 -> asciz string ;11 emt 365 ; .DOFSS ;11 tstb @#FIRQB ; Error? bne 20$ ; If so, just die mov @#XRB+10,r0 ; "flag word 2" bit #1400,r0 ; Wild p,pn ? beq 30$ ; No, ok 20$: jmp fwerr ; Yes, can't do it ; 30$: mov #FQBSIZ,r0 ; Allocate a call $$falo ; Wild card block mov r0,V$WILD(r4) ; Stuff it away mov r0,r2 ; Save a copy mov #FIRQB,r1 ; r1 -> firqb 40$: mov (r1)+,(r0)+ ; Save firqb cmp r1,#FIRQB+FQBSIZ ; all of blo 40$ ; it. movb #LOKFQ,FQFUN(r2) ; We'll use the lookup function mov #-1,FQERNO(r2) ; Initialize "current file number" bis #VF$WLD,V$WFLG(r4) ; Set wild-card bit for fnext() ;07/15 jmp fwexit ; Normal exit .even ; ; Here on native RT11 fwild call ; fwild1: ..revert native.. mov #V$SIZE+1024.,-(sp) ; Extend iov for block buffer ;15 mov r4,-(sp) ; realloc(iov, (V$SIZE + 1024.)); call realloc ; Extend cmp (sp)+,(sp)+ ; Remove parameters mov r0,r4 ; R4 -> IOV bne 10$ ; Br if it succeeded mov #E$$NSP,r0 ; error(not enough memory) jmp $$fope 10$: movb V$LUN(r4),r0 ; Reset iov pointer ;15+ asl r0 ; (lun as an index) mov r4,$$luns(r0) ; in the iov table mov r4,r0 ; r0 -> iov ;16 add #V$SIZE,r0 ; r0 -> data buffer mov r0,V$BASE(r4) ; record base mov #512.,V$RBSZ(r4) ; normal size record ;15- mov #WDBSIZ,r0 ; Allocate a wild data block call $$falo mov r0,V$WILD(r4) ; Hook it to iov mov r0,r3 ; r3 --> wdb clr (r0)+ ; Clear out the RAD50 filespec clr (r0)+ clr (r0)+ clr (r0)+ ; ; Test for and handle a device spec in the given filespec string. If there ; is none given, default to "DK:", the RT-11 default storage device. ; In any case, leave r1 -> first character in given file name. ; mov #3,r0 ; Look for ':' in 3 char positions mov C$PMTR+0(r5),r1 ; starting with inc r1 ; the second character 20$: cmpb #':,(r1)+ beq 30$ ; Found a ':', scan off the devspec dec r0 ; Loop to the end bne 20$ ; of the specification ; ; No device name, default to DK: ; mov C$PMTR+0(r5),-(sp) ; Save pointer to filename.ext mov #defdev,(r3) ; Set for default device br 40$ ; Go open the directory 30$: mov r1,-(sp) ; Save pointer to filename.ext mov r3,-(sp) ; (sp) --> wdb cell for device name mov C$PMTR+0(r5),-(sp) ; (sp) --> ASCII device name mov #4,-(sp) ; Compute device name length sub r0,(sp) ; (sp) = length of device name call ascr50 ; Convert to RAD50 in wdb add #<3*2>,sp ; Clean off stack 40$: mov r4,-(sp) ; Set up to open directory mov r3,-(sp) call dfopen ; Open directory cmp (sp)+,(sp)+ ; Clean off stack tst r0 ; If directory open error bne 50$ mov #E$$NOD,r0 ; error("No device") jmp $$fope 50$: bit #VF$FIL,V$FLAG(r4) ; If not a directory device ;15 bne 60$ ; ; Note: the code really should be clever enough to handle "any device" ; as long as there are no wild cards. Of course, the program could ; handle this as: ; if ((fd = fwild(name, mode)) == NULL && ; (fd = fopen(name, mode)) == NULL) ; error("can't open it noways"); ; mov #E$$NOD,r0 ; error("No device") jmp $$fope 60$: mov r3,-(sp) ; SAVESTATUS on the directory add #W.CHST,(sp) ; r0 --> ! 5 ! chan! mov V$LUN(r4),-(sp) ; ! cblk ! bis #<400*5>,(sp) ; .savestatus mov sp,r0 ; r0 -> parameter block emt 375 ; .savestatus bcc 70$ ; Continue if ok ; ; As dfopen has returned successfully, an error from savestatus is impossible ; CRASH ; "can't happen" 70$: cmp (sp)+,(sp)+ ; Junk the dpb. ; ; Scan the filename argument, building a match string in the ; wild-card buffer. Note that the filename and extension both terminate ; with blanks. The match string also terminates with a NULL to allow ; it's printing by a debugger. ; ; Ignoring the terminating NULL, the string is exactly 11 bytes long: ; ; -- 6 bytes filename (with blank padding as needed) ; -- 1 blank (instead of a dot) ; -- 3 bytes filetype (with blank padding as needed) ; -- 1 blank terminator ; ; ; Entry: ; (sp) --> source filename (after parsing device name) ; r3 --> Wild-card buffer ; r4 --> IOV ; SPACE = 040 ; Blank character's value scanst: mov (sp)+,r1 ; R1 -> source filename mov r4,-(sp) ; save IOV pointer mov r3,-(sp) ; save WDB pointer add #W.NAME,r3 ; R3 -> pattern area mov r3,r0 ; R0 -> pattern area mov #W.NSIZ-1,r2 ; R2 := pattern size (less NULL) 10$: movb #' ,(r0)+ ; Blank out the pattern dec r2 ; Count bytes bne 10$ ; Loop until done clrb (r0) ; NULL-trail the pattern mov #6.,-(sp) ; Filename is six bytes long ; ; Now: ; 4(sp) -> IOV ; 2(sp) -> WDB ; 0(sp) := maximum number of bytes in pattern segment ; r0 := current pattern byte ; r1 -> source string ; r2 := flag (-1 when the '.' is seen) ; r3 -> match buffer ; r4 -> scan table pointer ; scan: movb (r1)+,r0 ; Get next byte bne 10$ ; Br if not done ; ; At end of string, if the dot was seen, we're finished, else fake ; an asterisk ("foo" == "foo.*") ; tst r2 ; Dot seen if non-zero bne parsok ; Br if really done ; ; No dot seen, if (sp) == 6, we've been handed a null string, which isn't ; what we want. ; cmp (sp),#6. ; Scanned anything? beq prserr ; No, sorry. mov 2(sp),r3 ; r3 -> wdb movb #'*,W.NAME+7(r3) ; Stuff in an asterisk br parsok ; And exit normally. ; ; Not at the end of the string, do funny stuff if it's a dot ; 10$: cmpb r0,#SPACE ; Ignore control characters blos scan ; Br if blank, tab, etc. cmpb r0,#'. ; Not control, is it the fearsome DOT? bne 20$ ; Br if not com r2 ; Flip the DOT flag beq prserr ; Die if we've gotten DOTted twice mov 2(sp),r3 ; Move to the filetype section add #W.NAME+7.,r3 ; R3 -> first byte of filetype mov #3.,(sp) ; Set the count for the filetype br scan ; And continue ; ; If it's alphabetic, force it to uppercase (and drop parity, too) ; Then, scan the table to see if it's an acceptable character. ; 20$: cmp r0,#'A ; Is it alphabetic? blo 30$ ; Br (unsigned) if not bic #177640,r0 ; 'a' -> 'A', clear out high byte 30$: mov #sctab,r4 ; r4 -> scan table 40$: cmpb r0,(r4)+ ; Is it too low blo prserr ; Sorry about that cmpb r0,(r4)+ ; Is it within range blos 50$ ; Gotcha inc r4 ; Too high, drop the flag br 40$ ; And try another 50$: mov r0,-(sp) ; Save r0 ;16+ mov 6(sp),r0 ; r0 -> iov bisb (r4),V$WFLG(r0) ; Set "wild-card" flag in IOV mov (sp)+,r0 ; and restore r0. ;16- ; ; An OK byte ; dec (sp) ; Have we done enough? bmi prserr ; Exit if name or .ext is too long movb r0,(r3)+ ; Stuff the pattern byte br scan ; Back for more ; ; ; ; Error. exit through $$fope ; prserr: ; Parse error mov 4(sp),r4 ; Restore r4 --> iov to free buffers ..revert fwerr: ; Parse error mov #E$$ILF,r0 ; "Illegal filename" jmp $$fope ; finish up in fopen error native.. ; ; Successful parse/expansion. The wild match template is in the wdb. ; parsok: ; Parse OK tst (sp)+ ; Pop temp from stack mov (sp)+,r3 ; Restore r3 --> wdb mov (sp)+,r4 ; Restore r4 --> iov bit #VF$WLD,V$WFLG(r4) ; Wild? ;15 bne 20$ ; Br if so mov r3,r2 ; Copy original filespec to wdb add #W.DEV,r2 ; using the dev and wildmatch area mov c$pmtr+0(r5),r1 ; r1 --> supplied filespec 10$: movb (r1)+,(r2)+ ; Copy the filespec bne 10$ ; Until it's done br fwexit ; And exit normally 20$: ;;; mov r4,W.DENT(r3) ; Set for 1st entry in segment ;16 mov V$BASE(r4),W.DENT(r3) ; In the data buffer ;15 add #L.HDR,W.DENT(r3) ; At this point ;15 mov #1,W.DSEG(r3) ; Set for first segment ..revert ; ; Normal exit from fwild() ; fwexit: mov r4,r0 ; Return the iov pointer jmp cret$ ; ALL DONE. ; ; The scan table contains three bytes per entry: ; low_byte The lowest valid byte in the range ; high_byte The highest valid byte in the range ; flag 1 if this (range) signals a wild-card ; Note that the entries are ordered in ascending ASCII order. ; Note also that VF$WLD must be <= 128. ; .psect c$strn ;09 sctab: .byte '%,'%,VF$WLD .byte '*,'*,VF$WLD .byte '0,'9,0 .byte '?,'?,VF$WLD .byte 'A,'Z,0 .byte 377 ; Everything is too small for this one. .even ;09 .psect c$code ; ; fnext() ; ; If first call to fnext() ; If not wild open file normally (-> $$fopo) ; else ; If not wild ; Exit saying "no more files" ; else ; Close any currently open file on this LUN (dont free iov). ; ; If still more directory to search ; Reopen directory from status in wdb ; Repeat for each segment ; Read directory segment ; Compute dir. entry size ; Allocate a match working buffer ; Repeat ; If file type == permanent ; Convert RAD50 filename/type to ASCII ; If name matches template ; Do a savestatus on the directory ; Assemble a correct Ascii device:filename.type, ; Replace C$PMTR+0(r5) with ptr to the filename. ; Open file via $$fopa entry in fopen() ; Else ; Get next directory entry ; Until file type == end of segment marker ; Reset entry pionter in wdb to first entry ; Update segment number in wdb via link in current segment header ; Until end of directory ; Exit saying "no more files" ; ; The following was lifted from RT-11, the match routine is ; identical to that used in DUP (the RT11 file copy program). ; ; RT-11 DIRECTORY ENTRY DEFINITION ; A DIRECTORY ENTRY FOR A FILE STRUCTURED DEVICE'S DIRECTORY ; IS ORGANIZED AS FOLLOWS: ; ; OFFSET MEANING ; ------ ------- ; 0 STATUS WORD ; 4000 = END OF DIRECTORY SEGMENT MARKER ; 2000 = PERMANENT FILE ; 1000 = EMPTY ENTRY ; 400 = TENTATIVE ENTRY ON CHANNEL ; 2-7 FILNAM.EXT IN RADIX 50 ; 10 LENGTH OF HOLE ALLOCATED ON DEVICE ; 12 DATA LENGTH (HIGHEST BLOCK USED) ; 12 IS ALSO USED IN ENTER TO HOLD ADDRESS WHICH ; FLAGS A TENTATIVE ENTRY, AND IDENTIFIES IT FOR CLOSE ; 14 CREATION DATE ; ; THESE WORDS MAY BE FOLLOWED BY EXTRA 'USER' WORDS ; ; STATUS WORD VALUES: ENDBLK = 4000 ;END OF BLOCK MARKER PERM = 2000 ;PERMANENT FILE EMPTY = 1000 ;EMPTY ENTRY TENT = 400 ;TENTATIVE FILE DOFSET = 4 ;DIRECTORY SEGMENT #1 STARTS AT BLOCK 6 ; DIRECTORY ENTRY OFFSET DEFINITIONS E.NAME = 2 ;FILNAM.EXT STARTS AT WORD 2 E.LENG = 10 ;SIZE OF HOLE ALLOCATED E.USED = 12 ;HIGHEST BLOCK WRITTEN (NOW 0) E.CHAN = 12 ;WHILE TENTATIVE, HOLDS CHANNEL NUMBER E.JNUM = 13 ;FOR BF, HOLDS JOB NUM E.DATE = 14 ;CREATION DATE L.ENTR = 16 ;LENGTH OF DIR ENTRY ; THE DIRECTORY HEADER IS LOCATED AT THE FRONT OF EACH DIRECTORY ; SEGMENT. THE DIRECTORY PROPER STARTS AFTER THE HEADER. ; ; WORD MEANING ; ---- ------- ; 0 TOTAL NUMBER OF SEGMENTS. ; 1 SEGMENT NUMBER OF NEXT LOGICAL DIRECTORY SEGMENT IN LINKED LIST. ; 2 NUMBER OF HIGHEST SEGMENT IN USE. ; 3 NUMBER OF EXTRA BYTES IN EACH DIRECTORY ENTRY. ; 4 BLOCK NUMBER WHERE FILES IN THIS SEGMENT BEGIN. L.HDR = 12 ;LENGTH OF DIRECTORY HEADER IN BYTES. D.TOTAL = 0 ;TOTAL NUMBER OF SEGMENTS D.NEXT = 2 ;NEXT LOGICAL SEGMENT D.HIGH = 4 ;HIGHEST SEGMENT IN USE D.EXTR = 6 ;EXTRA BYTES PER ENTRY D.STRT = 10 ;STARTING BLOCK NUMBER FOR THIS SEGMENT. ; ; fnext() ; .mcall .reope .readw .close ; ; Entry point for fnext() ; fnext:: jsr r5,csv$ ; Link environments mov C$PMTR+0(r5),r4 ; r4 --> iov mov V$WILD(r4),r3 ; r3 --> wdb both.. ;07+ tst $$rsts ; If it is native RT11, beq fnext1 ; Continue natively ..revert rsts.. bit #VF$WF1,V$WFLG(r4) ; If it's the first call ;15 beq 10$ ; Don't close the file ; ; Close out the current file ; mov r4,r0 ; Make r0 non-zero call $$clos ; Close the file, keep iov bit #VF$WLD,V$WFLG(r4) ; Is it really wild? ;15 bne 10$ ; yes, continue clr $$ferr ; No, clear error code and ;10 jmp nomore ; take normal exit ; ; Ready to find the next file -- r3 -> firqb ; 10$: bis #VF$WF1,V$WFLG(r4) ; Mark second time around ;15 inc FQERNO(r3) ; Increment lookup count mov #FIRQB,r2 ; r2 -> system firqb 20$: mov (r3)+,(r2)+ ; Copy firqb cmp r2,#FIRQB+FQBSIZ ; Until blo 20$ ; it's done .PRIV ; Signal "RSTS call" CALFIP ; Lookup the file movb @#FIRQB,r0 ; Any errors? beq 40$ ; If ok, go open next cmp #E$$FNF,r0 ; File not found? bne 30$ ; No -- bad end clr r0 ; Yes, an acceptable error 30$: jmp $$fope ; Clean up and exit ; ; Got a file, make an ascii file name ; The longest file name is "_dk7:[100,100]foobar.foo" ; 40$: sub #26.,sp ; Get some stack space mov sp,r0 ; r0 -> work area mov #FIRQB+FQDEV,r2 ; r2 -> firqb @ device name tst (r2) ; is one specified? beq 70$ ; Don't output one if not. tstb @#FIRQB+FQDEVN+1 ; Real unit number, too? beq 50$ movb #'_,(r0)+ ; supress logical dev. name trans. 50$: movb (r2)+,(r0)+ ; device name movb (r2)+,(r0)+ ; both bytes tstb 1(r2) ; Real unit? beq 60$ ; No, ignore it movb (r2)+,(r0) ; unit number bisb #'0,(r0)+ ; (make it ascii) 60$: movb #':,(r0)+ ; Here's the device colon 70$: mov V$WILD(r4),r2 ; Get our wild card buffer mov FQPPN(r2),r2 ; Get ppn from .fss beq 80$ ; None, do file name movb #'[,(r0)+ ; Yes, output marker mov r0,-(sp) ; buffer mov r2,-(sp) ; onto the stack swab (sp) ; Get proj part bic #177400,(sp) ; Just the byte call itoa ; Convert it movb #',,(r0)+ ; syntax mov r0,2(sp) ; update buffer pointer mov r2,(sp) ; Get programmer number bic #177400,(sp) ; As a byte call itoa ; do it movb #'],(r0)+ ; more syntax cmp (sp)+,(sp)+ ; Clean up 80$: mov #FIRQB+FQNAM1,r2 ; R2 -> firqb @ file name mov (r2)+,r1 ; File name, part 1 call $$c5ta ; convert to ascii mov (r2)+,r1 ; File name, part 2 call $$c5ta ; convert to ascii movb #'.,(r0)+ ; Terminate file name mov (r2),r1 ; File extension call $$c5ta ; Into ascii clrb (r0) ; Terminate the file name mov sp,C$PMTR+0(r5) ; sp -> file name string ..revert both.. fnextx: ;12+ mov V$LUN(r4),r3 ; r3 := lun bic #VF$EOF!VF$ERR,V$FLAG(r4) ; No errors now ;13/15 clr V$BPTR(r4) ; Clear block pointer clr V$BCNT(r4) ; and block count clr V$BNBR(r4) ; and block number jmp $$fopa ; Open it up ;12- fnext1: ..revert native.. ; ; Here on RT11 native wild card open ; bit #VF$WF1,V$WFLG(r4) ; Is it the first call? ;15 bne 10$ ; Br if not bit #VF$WLD,V$WFLG(r4) ; Is it a wild file? ;15 bne 30$ ; Br if so mov r3,C$PMTR+0(r5) ; Get non-wild name br fnextx ; And go open it up. 10$: bit #VF$WLD,V$WFLG(r4) ; Not the first call, is it wild? ;15 bne 20$ ; Br if it's wild jmp nomore ; Not wild, close up shop 20$: mov r4,r0 ; Make r0 non-zero and call $$clos ; Close current file ; ; Setup to scan for the next file ; ; ; The filename is "dk1:foobar foo " [The blanks are mandatory] ; Make room for a filename on the stack. Note: at this point, any ; "push" must be matched by a corresponding "pop" as (sp) will be the ; first byte of the filename. ; 30$: sub #16.,sp ; Make ASCII match buffer mov r3,-(sp) ; add #W.CHST,(sp) ; Reopen the directory mov V$LUN(r4),-(sp) ; r0 -> ! 6 ! chan! add #<400*6>,(sp) ; ! cblk ! mov sp,r0 ; r0 -> argument block emt 375 ; .REOPEN bcc 40$ ; Branch if ok jmp nogood ; Exit if directory won't .reopen 40$: cmp (sp)+,(sp)+ ; Clean off the stack ; ; Loop through the directory ; fscan1: mov W.DSEG(r3),r1 ; Compute lbn of segment beq done ; Exit if at directory end asl r1 add #DOFSET,r1 clr -(sp) ; Build .readw parameter block mov #512.,-(sp) ; r0 -> ! 10 ! chan! mov V$BASE(r4),-(sp) ; ! blk ! mov r1,-(sp) ; ! buf ! mov V$LUN(r4),-(sp) ; ! wcnt ! add #<400*10>,(sp) ; ! 0 ! mov sp,r0 ; r0 -> argument block emt 375 ; .READW bcs nogood ; br if error reading directory add #<5*2>,sp ; Clean off the stack mov #L.ENTR,r0 ; Std dir. entry size = 7 words mov V$BASE(r4),r2 ; r2 --> directory header ;16 add D.EXTR(r2),r0 ; Add in extra bytes per entry mov r0,W.ESIZ(r3) ; Store entry size in wdb bit #VF$WF1,V$WFLG(r4) ; Second time through ;15 bne fscan3 ; Yes, step to next entry bis #VF$WF1,V$WFLG(r4) ; No set flag for next time. ;15 fscan2: ; Repeat for each entry mov W.DENT(r3),r2 ; r2 --> next entry bit #PERM,(r2)+ ; If file type isn't permanent beq fscan3 ; go for the next one. mov sp,r0 ; r0 --> ASCII buffer mov W.DEV(r3),r1 ; device name call $$c5ta ; to ascii movb #':,(r0)+ ; followed by a ":" mov (r2)+,r1 ; file name call $$c5ta ; to ascii mov (r2)+,r1 ; both halves call $$c5ta ; to ascii. movb #SPACE,(r0)+ ; Then a space, followed by mov (r2),r1 ; the extension call $$c5ta ; to ascii movb #SPACE,(r0)+ ; followed by a blank, clrb (r0) ; then terminate the string mov sp,r1 ; r1 -> ASCII string add #4.,r1 ; r1 -> file name mov r3,r2 ; r2 -> pattern string add #W.NAME,r2 ; (now it does) call match ; Match the file name tst r0 ; r0 != 0 if success beq fscan3 ; Br if no match mov sp,r1 ; r1 -> ASCII string add #<4.+7.>,r1 ; Step to filetype in name add #7.,r2 ; Step to filetype in pattern call match ; Match the filetype tst r0 ; r0 != 0 if success beq fscan3 ; Br if failure ; ; File name matches, stuff a dot and terminator to make fgetname happy. ; movb #'.,-(r1) ; Stuff a '.' clrb 4(r1) ; And terminate the name mov r3,-(sp) ; SAVESTATUS on the directory add #W.CHST,(sp) ; r0 -> ! 5 ! chan! mov V$LUN(r4),-(sp) ; ! cblk ! add #<400*5>,(sp) ; mov sp,r0 ; r0 -> argument block emt 375 ; .SAVESTATUS bcs nogood ; Exit on impossible error ; ; We have a file, sp -> file name string ; cmp (sp)+,(sp)+ ; Clear the stack mov sp,C$PMTR+0(r5) ; Stuff file name jmp fnextx ; Go open the file ; ; Not a permanent file, or no match for this one. ; fscan3: add W.ESIZ(r3),W.DENT(r3) ; Point to next entry ;; call test1 cmp @W.DENT(r3),#ENDBLK ; At end of segment? bne fscan2 ; Until type == end of segment mkr. mov V$BASE(r4),W.DENT(r3) ; Reset to 1st entry in segment ;15+ add #L.HDR,W.DENT(r3) ; ;; call test2 mov V$BASE(r4),r0 ;16 mov D.NEXT(r0),W.DSEG(r3) ; Link to next logical segment ;16 ;;; add #D.NEXT,W.DSEG(r3) ; Link to next logical segment;15-/16-- bne fscan1 ; Continue if more done: .CLOSE V$LUN(r4) ; Close directory channel ..revert ; ; Nothing left in the directory ; nomore: clr r0 ; Indicate no more files call $$fcls ; Close out the IOV clr r0 ; Successful finish ;13 jmp cret$ ; And exit native.. ; ; Unexpected error ; nogood: mov #E$$ERR,$$ferr ; Unexpected error br nomore ; Error exit ; ; Special routine for opening directory ; fp = dfopen(&r50nam,&iov) ; dfopen: jsr r5,csv$ mov C$PMTR+0(r5),r1 ; r1 --> RAD50 filespec (incl dev) mov C$PMTR+2(r5),r4 ; r4 --> iov mov V$LUN(r4),r3 ; r3 = lun jmp $$fopr ; Open with RAD50 spec ; ; ** MATCH ; ; This routine performs a wildcard pattern match against an ASCII ; pattern string. The matchable wildcards are: ; ; '%' or '?' Match any non-null, non-blank character ; '*' Match any (even null) string ; ; Both strings must end in an ascii blank. ; ; Entry: ; r1 string to match ; r2 pattern ; ; Return: ; r0 non-zero if there is a match ; r1 modified. ; match: jsr r5,$$svr1 ; Save registers r1-r5 clr r0 ; Assume failure mov #SPACE,r4 ; An ASCII blank is often used 10$: movb (r2)+,r3 ; Get the next pattern character cmpb #'*,r3 ; Is it an asterisk? bne 20$ ; Br if not cmpb (r2),r4 ; Are we at the end of the string? beq 30$ ; Br if so, we have a match. 20$: cmpb (r1),r4 ; At the end of the test string? bne 40$ ; Br if not. cmpb r3,r4 ; Yes, at the end of the pattern? bne 60$ ; Br if not, returning one level 30$: inc r0 ; Match br 60$ ; Take common return 40$: cmpb r3,r4 ; Is this the end of the pattern? beq 60$ ; Return if so cmpb #'*,r3 ; Is this the wild string pattern? beq 50$ ; Br if so cmpb (r1)+,r3 ; No, does it match the pattern? beq 10$ ; Br if so, try for another cmpb #'%,r3 ; No match, is it single-byte joker? beq 10$ ; It "matches" if so cmpb #'?,r3 ; Try for the RSTS joker beq 10$ ; It "matches" if so br 60$ ; Sorry, return one level. 50$: mov r1,-(sp) ; Asterisk, push r1 mov r2,-(sp) ; and r2 jsr pc,10$ ; and call ourselves mov (sp)+,r2 ; restore context mov (sp)+,r1 ; both of them tst r0 ; Did the strings match? bne 60$ ; Unwind if so cmpb (r1)+,r4 ; No, at the end of the test string? bne 50$ ; No, try another match 60$: return ; Unwind one level ..revert .endc .end -h- init.mac Thu Jan 19 14:37:01 1984 INIT.MAC;1 suspicious = 1 ; Enable this on new releases of vms .title $$init One-time initialization code .if ne RMSIO .ident "rms038" .iff .ident /000038/ .endc .list src,meb ; ;+ ; ; Index C program initialization ; ; Usage ; ; Internal ; ; $$init() ; ; Description ; ; When a C program is started, a command line is parsed ; to form the argv[] array and the standard input, output, ; and error files are opened. Note the following: ; ; On RSX11/M (even emulated), argv[0] will be set to the ; task name. On RT11 modes, argv[0] will be set to a dummy ; value. ; ; If no command line is passed to the program, it will prompt ; the task name (or "Argv") and read a line from the command ; terminal. To disable this, the user program may define ; a global flag as follows: ; ; $$narg = 1; ; main (argv, argc) { ; ... ; ; If $$narg is initialized non-zero and no command line is passed ; to the program, or if the initialization sequence fails to ; read an argument, main() will be called with one argument. ; ; The command line prompt may be changed from the task name (or ; "Argv") by defining a global string as follows: ; ; char *$$prmt = "Command line prompt" ; main(argv, argc) { ; ... ; ; On Vax VMS, the program may be installed as a "foreign command" ; by a command such as: ; ; $ command :== $disk:[dir]filename ; ; and executed by typing: ; ; $ command arg1 arg2 ; ; Internal ; ; MAINTAINERS, Please Note ; ; This module contains code that is sensitive to particular ; releases of the various operating systems. Also, there is ; code that is sensitive to the various types of operating ; system emulators. The maintainer should strive to keep all ; such code in this module. ; ; This module has been tested on VMS V3.0 and V3.1, RSTS/E V7.1, ; RT11 V4.0, and RSX-11M V4.0. It may not work correctly ; on earlier (or later) releases. ; ; Note especially the "secret patch" to allow Decus C to ; read stream files on VMS V3.0 (and V3.1), and the command ; line parser for VMS version 3.0 and later. This code ; will require examination on every release of VMS. ; ; Diagnostics ; ; Can't parse command line ; ; ?C-Standard input, [filename]: error text ; ; ?C-Standard output, [filename]: error text ; ; ?C-No memory. ; ; The "can't parse" message is given if the command line ; format is incorrect (because of unbalanced quotation marks, for ; example). ; ; The "standard input" or "standard output" messages are a ; user error if input or output are redirected and the associated ; files cannot be opened. The text should be self-explanatory. ; ; The "no memory" message suggests a severe ; case of program immensity. ; ; All errors are fatal. ; ; Bugs ; ; On RSTS/RSX, command lines are limited to 80 bytes, although ; 128 byte commands are feasable. On VMS V3.0 and V3.1, the command ; name includes the expanded form of the command name. This ; means that long command name translations coupled with long ; argument strings may cause the total argument string to exceed ; 80 bytes. Such arguments will be truncated by the operating ; system without warning. The work-around is to make use ; of logical names: ; ; $ assign $disk[directory.subdirectory] bin ; $ program :== $bin:prog ; ; The expanded form of the "program" command is just "bin:prog". ; ; On VMS V3.0 and V3.1, the distributed RSX file service (FCS) refuses ; to open "stream Ascii" files. This module contains a ; dynamically-installed patch to the open routine. An error ; message will be printed if the patch cannot be installed ; correctly. The VMS3.0 compile-time switch enables this ; patch. There is also code in fopen.mac that is affected ; by this patch. ; ; It might be reasonable to make error messages non-fatal ; so $$init could be called by a user program. ; ; On RSX, the program aborts (by executing a BPT instruction) ; if the program fails to open stderr or obtain partition parameters. ; ;- ; ; Edit history: ; 000001 20-May-80 MM Complete rewrite ; 000002 16-Jun-80 MM Dumb bug ; 000003 23-Jun-80 MM Some RT11 stuff ; 000004 09-Jul-80 RD/MM Revised for native RT11 ; 000005 21-Jul-80 MM Added 50/60 Hertz for RT11 ; 000006 25-Jul-80 MM Added $$narg test ; 000007 29-Jul-80 MM Added initialization for sbreak(), bummed code ; 000008 30-Jul-80 MM Redid RSTS/E command line scan (gave up) ; 000009 04-Aug-80 MM Dumb bug in native RT11 ; 000010 26-Sep-80 MM Determine $$rsts using KED and TECO sequence ; 000011 18-Nov-80 MM stderr to CO: on VMS ; 000012 10-Dec-80 MM Added $$vms, got task name on RSX modes. ; 000013 09-Jan-81 MM Patch 12 needs band-aid for RSTS (dunno about RSX) ; Note: this probably could stand a cleanup. ; 000014 12-Jan-81 MM bummed code after patch 12 and 13 ; 000015 19-Jan-81 MM Bummed one word ; 000016 24-Mar-81 RBD Tell RT11 monitor to leave stuff in lower case ; 000017 09-Apr-81 MM Task name hack for M+ (?) ; 000018 05-May-81 LMF/MM RSX-11 prompts for arg's, too. ; 000019 01-Jun-81 MM Incredible VMS 2.3 hack ; 000020 19-Jun-81 JSL Fixed typo in edit 19 ; 000021 08-Oct-81 MM Conditionalized edit 19 ; 000022 22-Jan-82 MM/RBD/JB Task name and RSTS V7.1 fixes ; 000023 03-Jun-82 MM VMS 3.0 hack, sicker and sicker ; 000024 07-Jun-82 MM I may be paranoid, but... ; 000025 08-Jun-82 MM Cleanup, removed untestable RSTS V6C specific code ; 000026 15-Jun-82 MM Changed CO: to CL: for console log device. ; 000027 15-Jun-82 MM Stupendous vms hack for stream files. ; 000028 17-Jun-82 MM Debugged above hack ; 000029 15-Jul-82 MM RSTS/E get core common fixup; use .ttyin to get args ; 000030 19-Jul-82 MM Added $$pos ; 000031 09-Aug-82 MM Dump anything in local tty buffer on rt11 ; 000032 20-Aug-82 MM Added "suspicious" -- no code changes ; 000033 23-Aug-82 MM Make patch 27 work if program is RUN ; 000034 30-Aug-82 MM Reorganize code so stderr is open when patch 27 is done ; 000035 18-Oct-82 MM Fix bug in RT-11 Argv processing ; 000036 21-Oct-82 TTC Added $$prmt ; 000037 27-Oct-82 RBD No longer set VF$NEWL on stdout. Init stderr to have ; VF$NEWL set. Since all console output goes through ; stderr, the first call to $$get will flush out the ; pending newline. (sick) Be rude on memory allocation ; failure on RSX. ; RMS038 17-Dec-83 RBD Added conditional support for RMS-11(V2) ; .iif ndf rsx rsx = 1 ;Assume RSX11M .iif ndf vms2.3 vms2.3 = 0 ;Assume no funnies ;27/28 .iif ndf vms3.0 vms3.0 = 0 ;Things got funnier ;23/28 .iif ne vms3.0 vms2.3 = 0 ;Only want one ;23 .iif ndf suspicious suspicious = 0 ;For vms error msg. ;31 .if ne rsx ; ; RSX11-M specific globals and macro definitions ; .psect c$data .if ne RMSIO .mcall $CREATE $CONNECT ;38 .mcall GSA$ ORG$ $COMPARE ;38 ORG$ SEQ, GSA$ $$GSA ; My get space routine .psect c$data .iff .mcall FDBDF$, FDAT$A, FDRC$A, FDOP$A, NMBLK$, NBOF$L, OPEN$W ;10 NBOF$L ;10 .endc .mcall GTSK$S, EXIT$S, GPRT$S ;07 .mcall QIOW$S ;18 ; Note: GMCR$ is also needed, but it cannot be made re-entrant. Clever. .globl .nluns .globl $$prmt ;36 ; ; Equivalences. ; MAXMCR = 80. ;Mcr command line size ; .iff ; ; RT11 specific macros and equivalences ; .mcall .print, .scca, .ttyin, .gval ;04/29 .mcall .rctrlo ;16 USERSP = 42 ; Initial stack pointer JSW = 44 ; Job status word HIMEM = 50 ; High-water mark of memory ;07 SYSPTR = 54 ; R/W area pointer CNFIG1 = 300 ; Configuration word 1 ;05 TTICNT = 670 ; TTY buffer count (RSTS/E RT11 only) ; TTSPC$ = 010000 ; No echo bit TTLC$ = 040000 ; Don't translate upper case KEEPCC = 100000 ; Keep core common (RSTS/E only) ;29+ ; ; Initialize the job status word. KEEPCC is used, on RSTS/E emulation, ; to preserve the core-common contents on entrance. ; .asect . = JSW .WORD KEEPCC+TTLC$ .psect c$code ; ; Some character definitions ; LF = 12 CR = 15 TAB = 11 ; .endc ; ; Common definitions ; SPACE = 40 ;18 R.PARM = 30 ; RSX or RT emulator chain line number ; (this is FIRQB @ FQNENT) CORCMN = 460 ; RSTS/E core common ISRSTS = 4 ; Returned by GTSK$ for RSTS ISVMS = 5 ; Returned by GTSK$ for VMS ISMPLUS = 6 ; Returned by GTSK$ for RSX-11M+ ISPOS = 11 ; Returned by GTSK$ for P/OS (Professional) .psect c$data .if eq RSX ;30 ; ; These must stay in order ; defcmd: .ascii /Argv:/ ;Dummy command line for RT11 ;04+ defcbl: .ascii / / ;Space following "argv:" clibuf: .byte 200 ;Terminate default command (overwritten) .blkb 129.-<.-defcmd> ;Command line (or core common) ;04- cliend = . ;End of command line ;29 .endc ; ; Assorted ASCII things. ; Arg strings for 'fopen'. ; Format strings for 'fprintf'. ; Note: these are in $code so they sit in the overlay segment ; .psect c$code r: .asciz "r" w: .asciz "w" a: .asciz "a" nullst = .-1 ;A null string ;12 outtxt: .asciz /output/ inptxt: .asciz /input/ badopn: .asciz /?C-Standard %s, / ;29 badmem: .asciz /?C-No memory./<12> .if ne rsx badm2: .asciz / Is this task checkpointable?/<12> ;37 .endc badcmd: .asciz /?C-Can't parse command line./<12> .if ne vms3.0 ;27+ .if ne suspicious ;31 badpat: .asciz /%C-Can't install vms v3 patch. Get help./<12> ;28 ; ; Maintainers -- this message will be printed if the file control service ; "open by filename block" routine is later than the version (VMS V3.0 ; on which it was developed. If this happens, you should take the following ; actions: ; 1. Check whether Decus C programs can OPEN "stream format" files ; without the patch. If so, the RSX AME maintainers have corrected ; the problem that prompted this patch. (You can try compiling ; a stream-format file -- this patch is not in the compiler.) ; ; 2. If the stream file opens successfully, disable the patch in ; FOPEN.MAC and check whether the file can be read successfully. ; A simple program such as: ; while (fgets(buffer, sizeof buffer, stdin) != NULL) ; fputs(buffer, stdout); ; should suffice. Use the VMS DIFFERENCES program to check that ; the output file is correctly copied. If so, eliminate the ; code in this module and FOPEN.MAC. Watch out: the VMS3.0 ; flag is used for command line parsing, too. ; ; If the file can be opened, but not read, reenable the patch ; in FOPEN.MAC and see if that works. ; ; 3. At this point, you have a problem. Look around your distribution ; kit for the command files to build SOS. See if there is a ; dynamic patch to FCS .OPFNB that can be used as a model for ; upgrading this patch. ; ; 4. If that didn't work, dump out code around the current patch ; location to see if anything interesting turns up. The ; code tests the record format and rejects the open if the ; value exceeds a certain value. ; ; 5. Be joyful that your VMS system is supported, even if Decus C isn't. ; Have you considered Vax-11 C? It's really very good. ; .endc ;31 .endc ;27- .if ne vms3.0 ;24+ ; ; This is a string of funny characters that drops the space between ; the command and first argument. See below. ; stlist: .asciz "#()+,-/>?]^" ; .endc .even .MACRO PRINTF FMT,A1,A2,A3,A4,A5,A6,A7,A8,A9,?FORMAT,?EXIT MOV R0,-(SP) MOV R1,-(SP) $$$$$$ = 4 .IF NB A9 MOV A9,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A8 MOV A8,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A7 MOV A7,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A6 MOV A6,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A5 MOV A5,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A4 MOV A4,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A3 MOV A3,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A2 MOV A2,-(SP) $$$$$$ = $$$$$$+2 .ENDC .IF NB A1 MOV A1,-(SP) $$$$$$ = $$$$$$+2 .ENDC MOV #FORMAT,-(SP) MOV STDERR,-(SP) CALL FPRINTF ADD #$$$$$$,SP MOV (SP)+,R1 MOV (SP)+,R0 BR EXIT FORMAT: .ASCII FMT .BYTE 12,0 .EVEN EXIT: .ENDM PRINTF .MACRO NOTE TEXT,?TLOC,?EXIT mov r0,-(sp) mov #tloc,r0 call $$msg mov (sp)+,r0 br exit tloc: .asciz text .even EXIT: .ENDM NOTE ; .psect c$code $$init:: jsr r5,csv$ ;Link environments .if ne rsx ; RSX11-M+ ; ; RSX11M specific code: clear lun table, ; and parse the command line. Note that, on RSTS/E, the command line ; may be stored in core-common (if CRUN.BAS chained to the C program) ; mov .nluns,r1 ;Linker lun maximum cmp r1,#$$lmax ;Max in table blos 20$ ;No, continue mov #$$lmax,r1 ;Yes, set max we can handle 20$: mov r1,$$nlun ;Set known lun maximum mov #$$luns,r0 ;Address lun table ; 30$: clr (r0)+ ;Empty this table entry cmp r0,#$$lune ;At the end? blo 30$ ;And loop for them all ; ; Initialize free memory pointers ; sub #3*2,sp ; Get partition return area ;07+ mov sp,r1 ; r1 -> gprt$ buffer GPRT$S ,r1 ; Get partition parameters bcc 35$ ; Continue if we got it CRASH ; Can't happen 35$: mov 2(r1),r1 ; Partition size in clicks asl r1 ; Shift left to mul. by 32 asl r1 ; asl r1 ; asl r1 ; asl r1 ; asl r1 ; add $dsw,r1 ; Top of memory (correctly) mov r1,$$mend ; Save true top of memory add #3*2,sp ; Dump the stack ;07- ; ; Do a get task to get the task name and default UIC ; GTSK$S #$$erec ;Get task parameters mov #2,(sp) ;Get task name (2 words) ;07 mov #$$erec+<0.*2>,-(sp) ;From here mov #$$task,-(sp) ;To here call r50toa ;Using C library routine cmp (sp)+,(sp)+ ;Cleanup stack ;07 clr (sp) ;Assume no task name needed ;12/14/22 mov $$erec+<7.*2>,$$uic ;Default uic word (word 07) mov $$erec+<14.*2>,$$opsy ;Op. system unique code cmp $$opsy,#ISRSTS ;Good old RSTS? bne 40$ ;Not today inc $$rsts ;Here's someone who knows better ;; clr (sp) ;No task name for RSTS ;14/25 40$: ; .if eq RMSIO cmp $$opsy,#ISVMS ;VMS? ;10+ bne 42$ ;No ;22/30 mov #"CL,$$efnb+N.DVNM ;Yes, output to SYS$ERROR ;26 inc $$vms ;Set flag ;12 .if eq VMS3.0 ;23 mov #$$task,(sp) ;Task name needed -- Note: this may ;22+ ; be version-specific. It is needed ; on versions V2.3 and V2.4. It has ; been suggested that it is not needed ; on version V2.5. So it goes. .endc ;23 .iff ;eq RMSIO 42$: $CREATE #$$efab ;Create error file ;38+ mov #$$erab,r0 ; R0 --> error file RAB $CONNECT r0 ; and connect to it. $COMPARE #SU$SUC,STS,r0 beq 43$ ;Ok, continue ;38- .ift 42$: OPEN$W #$$efdb ;Open error file bcc 43$ ;Ok, continue .endc CRASH ;Die. 43$: ;10- .if eq RMSIO .if ne VMS3.0 ;33+ ; ;27+ ; Patch the open module to allow reading "stream-Ascii" files. ; Warning -- this patch is release specific. ; See the note at BATPAT: above. ; tst $$vms ;On vms? beq 46$ ;Don't do the patch if not. .if gt suspicious-1 ;Suspicious == 2 to dump .opfnb mov #.OPFNB+1150,r1 ;r1 -> place to patch call regdmp mov r1,r0 ;Get a range sub #32.,r0 add #32.,r1 call $$dump .endc mov #.OPFNB+1150,r1 ;r1 -> place to patch cmp (r1),#3 ;Correct value? .if eq suspicious bne 46$ ;No, don't do the patch ;28 .iff beq 44$ ;Yes, install the patch mov stderr,-(sp) ;Print a message mov #badpat,-(sp) ; on the console call fputs ; as a warning br 46$ ; and don't do the patch 44$: .endc ;31- mov #6.,(r1) ;Do it 46$: ; ;27- .endc ;33- .endc cmp $$opsy,#ISPOS ;P/OS (Professional) ;30+ bne 48$ ;No inc $$pos ;Set flag if so ;30- 48$: ;17-/22- ; ; Get command line. ; mov #MAXMCR+4,r0 ;Get command line buffer ;23 call $$aloc tst r0 ;zero means trouble bne 50$ ;Ok, continue mov #badmem,(sp) ;No core ;12 .if ne rsx mov #stderr,-(sp) ;(first line) ;37+ call fprintf tst (sp)+ mov #badm2,(sp) ;(second line) ;37- .endc jmp fail ;No return ;18 50$: mov r0,-(sp) ;GMCR buffer address ;25 mov (pc)+,(r0)+ ;Fake MCR dispatch (GMCR$S) ;25 .byte 127.,41. ;as RSX can't do it at runtime emt 377 bcs 55$ ;Br if failure ;19+ mov $dsw,r2 ;R2 has number of bytes ;22+/23+ add r0,r2 ;R2 -> last byte in buffer ; ; Note: r2 -> last byte in buffer ; clrb (r2) ;Nullify it ;22-/23- .if ne VMS2.3 ;Needed on VMS release 2.3 and 2.4 ; ; The following piece of nonsense is due to an error in the RSX AME for ; VMS releases V2.3 and V2.4. (See following for VMS 3.0) ; The problem is that, if a C program is installed as a "foreign ; command", and the command line passed to the program starts with a '-', ; the last byte of the command is passed in the buffer. If not, the first ; byte of the command buffer is blank. Note the following cases for a ; program, FOO.EXE, defined as "$ FOO :== $DISK:[DIR]FOO": ; User types GMCR$ returns (quotes added): ; FOO 'O' ; FOO BAR ' BAR' ; FOO -x 'O-X' ; FOO "-x" ' "-x"' ; ; Note that the "mov #$$task,(sp)" above may -- I repeat, may -- be ; release specific. ; tst $$vms ;If it isn't vms, beq 5410$ ;We don't have to do this mov r0,r1 ;r1 -> first byte of the buffer cmpb #'A,(r1) ;If the first byte of the buffer bhi domcr ;Isn't alphabetic, just go right on cmpb #'Z,(r1)+ ;Check both ends blo domcr ;of the alpha scale: branch if not. ;20 movb #SPACE,-(r1) ;Yep, hack around it .endc .if ne VMS3.0 ;23/24+ ; ; For VMS 3.0, things got worse. The entire command (after argument ; expansion) is in the gcml buffer with the '-arg' tacked onto the end ; as before. Thus, if a program, FOO.EXE is installed as ; ; $ FOO :== $DISK:[DIR]FOO ; ; and invoked as ; ; $ FOO -arg1 arg2 ; ; the GMCR$ buffer contains ; ; "DISK:[DIR]FOO-ARG1 ARG2" ; ; Even worse, "FOO >outfile" becomes "FOO>OUTFILE". ; Indeed, there are other bytes in addition to '-'. The current ; list is defined by the stlist: string. ; ; We "fix" this by sliding the buffer over one byte if necessary. ; During the search, we skip over strings of '[...]' and '<...>'. ; What a mess. ; tst $$vms ;If it isn't vms beq 5410$ ;We don't have to do this mov r0,r1 ;r1 -> first byte in buffer 52$: ; ; Not in an account string ; movb (r1)+,r3 ;Get byte, at end of command line? beq 5410$ ;yep cmpb #SPACE,r3 ;or blank? beq 5410$ ;yep ; ; Search stoplist ; mov #stlist,r4 ;r4 -> stlist 5210$: cmpb r3,(r4) ;interesting? beq 53$ ;gotcha. tstb (r4)+ ;nope, last? bne 5210$ ;try another cmpb #'[,r3 ;Account start? beq 5220$ ;Yep, more trouble starts cmpb #'<,r3 ;Tops account start? bne 52$ ;Nope, try another mov #'>,r3 ;Terminator br 5230$ ;Onwards ; ; Skip over the account string ; 5220$: mov #'],r3 ;Account terminator 5230$: tstb (r1) ;Null? beq 5410$ ;exit -- confused cmpb (r1)+,r3 ;Proper ending? beq 52$ ;Yep, onwards br 5230$ ;More to follow. ; ; Slide the rest of the buffer down, remember, r2 -> trailing null. ; 53$: dec r1 ;r1 -> funny byte 5310$: cmp r2,r1 ;Gone back far enough? blo 54$ ;ok, onward movb (r2),1(r2) ;slide it up tstb -(r2) ;work backwards br 5310$ ;ok 54$: movb #SPACE,(r1) ;room for the space now. .endc ;23- ;5410$: br domcr ;Onward, ever onward ;19-;24- 5410$: jmp domcr ;36 ; ; On many (native) RSX-11 systems, installing all C programs as tasks ;18+ ; is expensive, as it requires system pool space. The following ; modification prompts "Argv>" if no command line was passed by MCR. ; Note that the code depends on the fact that the command line is ; word-aligned. ; 55$: ;19 tst $$narg ;Really want a command line? bne 80$ ;If ne, supresss prompt, and go on. mov r0,r1 ;copy mcr buffer address mov #$$task,r2 ;get address of our task name .rept 3 ;Copy task name mov (r2)+,(r1)+ .endr 70$: cmpb #SPACE,-(r1) ;Any spaces in the name? beq 70$ ;Check 'em all ; ; Note: the above loop depends on the fact that the GMCR directive ; has put a non-space character (actually, '1') at the left end of ; the MCR buffer. ; 75$: inc r1 ;r1 -> first blank character movb #'>,(r1)+ ;Make it look like an RSX prompt movb #SPACE,(r1)+ ;Space it out a little ;25 mov r1,r2 ;r2 -> end of string sub r0,r2 ;Get length with terminators mov r0,-(sp) ;Save for later ;36+ tst $$prmt ;User supply prompt? beq 78$ ;No, use task name mov $$prmt,r2 ;r2 --> user prompt string 76$: tstb (r2)+ ;end of string? bne 76$ ;keep goin' mov $$prmt,r0 ;36- sub r0,r2 78$: qiow$s #IO.WVB,#1,#1,,#$$iosb,, ; prompt for argv mov (sp)+,r0 ;Restore r0 bcs 80$ ;No arg line if error movb #SPACE,-2(r1) ;Overwrite the '>' ;25 dec r1 ;Fix so r1 -> just after space ;25 qiow$s #IO.RVB,#1,#1,,#$$iosb,, ; read rest of input bcs 80$ ;No command if error cmpb $$iosb,#IS.SUC ;Finish ok? bne 80$ ;No command if error finish add $$iosb+2,r1 ;Point to the end of the string clrb (r1) ;Terminate the string ;; clr (sp) ;No extra task name, please ;25 br domcr ;Gotcha 80$: ;Here if we couldn't get one ;18- ; ; No GMCR command line. If this is RSTS/E, look in core common, too. ; mov #$$task,(sp) ;Make sure there's a task name tst $$rsts ;Running under RSTS/E? beq nomcr ;No, nothing doing mov @#R.PARM,r1 ;Yes, grab line number from RSX emulator bic #100000,r1 ;Ignore "retain privileges" cmp #29000.,r1 ;At the magic line or better? bgt nomcr ;He's not a wizard, then mov #CORCMN,r1 ;Yes, r1 -> core common buffer clr r2 ;Get common length bisb (r1)+,r2 ;r2 := number of bytes in common beq nomcr ;If zero, common is empty mov r0,r3 ;Common exists, get a buffer copy 60$: movb (r1)+,(r3)+ ;Copy bytes to local buffer dec r2 ;Counting them all the while bne 60$ ;Keep on trucking ;; clr (sp) ;No task name for first argument ;12/15 br domcr ;And go do it nomcr: tst -(r0) ;Repoint r0 to buffer true start ;25 call $$free ;If no line, release buffer mov #nullst,r0 ;Point to null string ;12/25 domcr: mov #$$argv,-(sp) ;Gets argv pointer ;07/12 mov #$$ofil,-(sp) ;Gets > redirection mov #$$ifil,-(sp) ;Gets < redirection mov r0,-(sp) ;And stuff command line, too. .iff ; ; RT11 specific code: set lower-case bit, check if it's really RSTS/E ; emulation. Then do an incredable hack on RSTS to find the command line. ; This code has been heavily reorganized -- the edit numbers were removed. ; mov @#HIMEM,r1 ; Save top of memory inc r1 ; Push it up bic #1,r1 ; to the first free byte mov r1,$$mend ; and save it. ;; bis #TTLC$,@#JSW ; set lower-case bit (in asect) clr (sp) ; No task name hack needed mov #$$argv,-(sp) ; Where argv[] goes mov #$$ofil,-(sp) ; where stdout redirection goes mov #$$ifil,-(sp) ; Where stdin redirection goes mov #defcmd,-(sp) ; Default command line mov #clibuf,r2 ; User supplied Argv line cmp -(sp),-(sp) ; Get temp for .gval mov sp,r1 ; R1 -> .gval pmtr. block .gval r1,#CNFIG1 ; Get configuration word 1 bit #40,r0 ; Bit 5, set if 50 Hertz beq 10$ ; Br if 60 Hertz mov #50.,$$tick ; Set 50 Hertz clock 10$: ; ; ; Note: someday, we may have to test for RT11 emulation on vms, too. ; .gval r1,#0 ; Get first word of RMON tst r0 ; It's non-zero on native RT11 bne 30$ ; Branch if so. ; ; Setup for RSTS/E ; inc $$rsts ; zero means rsts/e, set flag ; ; Under RSTS/E, we have to trap CTRL/Z so stdio can return EOF ; .scca r1,#$$scca ; Call with non-zero argument ; ;31+ ; Dump the RT11 emulator's local buffer. Note that this is somewhat ; undocumented. ; 14$: .gval r1,#TTICNT ;Anything in the buffer? tst r0 ;Well? beq 18$ ;Exit if nothing there .ttyin ;Get the byte br 14$ ;Go for another 18$: ;Main sequence ;31- ; ; Look for something in core common. ; mov @#R.PARM,r1 ;Yes, grab .run line number bic #100000,r1 ;Ignore "retain privileges" cmp #29000.,r1 ;At the magic line or better? bgt 30$ ;He's not a wizard, then mov #CORCMN,r1 ;Yes, r1 -> core common buffer clr r2 ;Get common length bisb (r1)+,r2 ;r2 := number of bytes in common beq 40$ ;If zero, common is empty mov #defcmd,r3 ;Common exists, get a buffer copy 20$: movb (r1)+,(r3)+ ;Copy bytes to local buffer dec r2 ;Counting them all the while bne 20$ ;Keep on trucking br 40$ ;Continue main sequence ; ; Here for native RT11 or to prompt for a command on RSTS/E RT11 ; 30$: ; Here to prompt on RSTS/E, too tst $$narg ; Don't ask for "Argv: " if set bne 40$ ; Br if user set the flag tst $$prmt ; User supply prompt? ;36+ beq 33$ ; No mov $$prmt,r0 ; Yes, r0 --> prompt string 31$: tstb (r0)+ ; Null? bne 31$ ; check next byte 32$: movb #200,-(r0) ; replace null in $$prmt with 200 .rctrlo ; Refresh lc bit (SPR 11-35833) .print $$prmt ; Yes, use user's prompt string br 35$ ; Get command line ;36- 33$: .rctrlo ; Refresh lc bit (SPR 11-35833) .print #defcmd ; Get command line ; ; There is a bug in .gtlin on RSTS/E V7.1. Therefore, we use .ttyin ;29+ ; to read the line. On entry, r2 -> command line. ; 35$: .ttyin ; Get a byte cmpb r0,#CR ; Return? beq 35$ ; Skip it if so cmpb r0,#LF ; Linefeed beq 36$ ; Exit if so movb r0,(r2)+ ; Output the byte cmp r2,#cliend-1 ; Too far? ;35 blo 35$ ; No, get the next byte 36$: clrb (r2) ; Terminate the line ;29- 40$: cmp (sp)+,(sp)+ ; Pop .gval and .scca temp .endc ;RT11- ; ; Common code -- parse the command line and open stdin/stdout ; docmd: call $$gcmd ;Parse it cmp r0,#-1 ;Badly parsed? beq cmderr ;Sorry. mov r0,$$argc ;and save the count add #<4*2>,sp ;Clear the stack ;07/12 ; ; Open standard streams. ; Note that 'stderr' is already open. ; It has to be to insure diagnostics get out. ; ;printf <"Opening input [%s]">,$$ifil mov #r,(sp) ;fopen(stdin, "r") ;07 mov $$ifil,-(sp) call fopen tst (sp)+ ;Pop temp ;07 mov r0,stdin ;Save ioptr bne 10$ ;Ok mov $$ifil,-(sp) ;Input file ;29+ mov #inptxt,-(sp) ;input message br iofail ;29- 10$: ;printf <"Opening output [%s]">,$$ofil mov #w,(sp) ;fopen(stdout, "w" or "a") ;07 mov $$ofil,r0 ;Get pointer to name cmpb (r0),#'> ;Append? bne 20$ ;Br if not mov #a,(sp) ;yes, say so inc r0 ;and point to real name 20$: mov r0,-(sp) call fopen mov r0,stdout bne go mov $$ofil,-(sp) ;Problem file ;29+ mov #outtxt,-(sp) ;error message br iofail ;29- go: jmp cret$ ;All finished ; ; iofail is entered with the stack as follows: ;29+ ; 0(sp) #intext or #outtxt ; 2(sp) ->filename ; iofail: mov #badopn,-(sp) ;Format mov stderr,-(sp) ;to stderr call fprintf ;print it add #3.*2,sp ;clean the arguments call perror ;do error message, too jmp $$fail ;and exit ;29- cmderr: mov #badcmd,-(sp) fail: mov stderr,-(sp) ;Save ioptr and ;02 call fprintf ;Put out message jmp $$fail ;and abort .end -h- ioget.mac Thu Jan 19 14:37:01 1984 IOGET.MAC;1 .title $$get Get a record .if ne RMSIO .ident "RMS012" .iff .ident /000012/ .endc ; ;+ ; ; Internal ; ; Index Get a record (internal) ; ; Usage ; ; RSX: ; mov #iov,r4 ;r4 -> i/o vector ; mov #buffer,r0 ;r0 -> buffer ; mov buflen,r1 ;r1 := max. buffer size ; call $$get ;Get a record ; ; VF$EOF and/or VF$ERR are set on error or end of file. ; r0 := actual record length, -1 on error or end of file. ; ; Other registers preserved. ; ; RT11: ; mov #blknbr,r0 ;r0 := block to read ; call $$get ;Get a block ; ; VF$EOF and/or VF$ERR are set on error or end of file. ; r0 is zero if success, -1 on error or end of file. ; ; Other registers preserved. ; ; clr r0 ;End of file error ; jmp $$geof ;(called by $$getc) ; ; Description ; ; $$get is the internal "get a record" routine. Note that ; the maximum record size (r1) is only needed on RSX. It is fixed ; at 512. bytes on RT11. ; ; If the file is defined as "stream" (the "n" flag was not set ; when the file was opened using fopen()), the end of the line ; will be represented by the newline (\n) character, and ; NULL's will be removed. ; ; Bugs ; ;- ; ; Edit history ; 000001 14-Oct-81 MM Split out from getc.mac ; 000002 24-Nov-81 SDR Clear "was eof" bit in fdb on tty's (for RSX) ; 000003 14-Jan-82 MM Fixed bug and moved "was eof" to cleare.mac ; 000004 08-Feb-82 MM/SDR Redid 02/03 to correspond with Unimation sources ; 000005 01-Jul-82 MM Newer library ; 000006 16-Sep-82 MM Support for .gtlin ; 000007 29-Sep-82 MM No more busy bit ; 000008 27-Oct-82 RBD Reading a record from the terminal sets "newline ; pending". ; 000009 23-Dec-82 TTC Fixed bug. Was using r4 instead of r0 in test for ; EOS loop for RT11 version. Also, return byte count ; in r0, instead of clearing it on RT11. ; 000010 24-Dec-82 RBD Flush stderr and set pending newline on same ; regardless of assignment of stdout. ; RMS011 17-Dec-83 RBD Add conditional support of RMS-11(V2) ; RMS012 02-Jan-84 RBD Bug in buffer handling for fget(). ; .iif ndf rsx rsx = 1 ;Assume RSX11M .iif ndf rmsio rmsio = 0 ;Assume FCS-11 .if ne rsx ;02 .if ne RMSIO .mcall $GET $STORE $FETCH $COMPARE ;11 .iff .mcall GET$ .endc .psect c$code ; ; ; Get record. ; r0 = buffer address. ; r1 = max record size. ; ; Sets IOV on EOF or error (IOV VF$EOF and/or VF$ERR set) ; Record length in r0 -- -1 if error ; $$get:: mov r0,-(sp) ;Save registers mov r1,-(sp) ; mov r2,-(sp) ; mov r3,-(sp) ; mov r0,r2 ;r2 -> buffer ; ; Note: the record buffer address is at 6(sp) ; ; Record devices. ; bit #VF$REC,V$FLAG(r4) ;Record device? ;05 beq 10$ ;Br if not cmp r4,stdin ;Are we reading standard input? bne 10$ ;No ; ; Standard input/standard output ; Magic on a tty. ; bit #VF$TTY,V$FLAG(r4) ;Yes, is it a TTY? ;05 beq 10$ ;No ;;; mov stdout,r0 ;Is the standard output ;10+ ;;; bit #VF$CMD,V$FLAG(r0) ; actually the "command terminal"? ;05/08 ;;; beq 10$ ;No ;10- ; ; If we get here, then we are reading from the user's command terminal ; keyboard. All output from stdout will be diverted ; to stderr. The act of reading a record from the console implies a ; pending linefeed, so we set VF$NEWL to force a leading on the next ; output. Here we flush so that "prompting" output (not ending in \n) ; will get out to the typing unit. ; mov r4,-(sp) ;Yes, flush out the mov stderr,r4 ;Point explicitly to stderr ;08 call $$flsh ;Flush it (actually stderr) bis #VF$NEWL,V$FLAG(r4) ; Set pending newline ;08 mov (sp)+,r4 ;Restore the IOV address ; ; Read record ; 10$: mov r4,r0 ;R0 --> iov .if ne RMSIO add #V$RAB,R0 ;r0 --> RAB ;11+ $STORE R2,UBF,R0 ;12 $STORE R1,USZ,R0 ;12 $GET R0 $COMPARE #SU$SUC,STS,R0 beq 20$ $FETCH R0,STS,R0 ;11- .iff add #V$FDB,R0 ;r0 --> FDB GET$ r0,r2,r1 ;Get the record bcc 20$ ;No problem movb F.ERR+V$FDB(R4),R0 ;Get error code .endc mov r0,$$ferr ;Save in $$ferr for user bis #VF$EOF,V$FLAG(R4) ;Trouble, force end of file ;05 cmp #IE.EOF,r0 ;Was it end of file? bne geterr ;No, set error bit, too. ;04+ bit #VF$TTY,V$FLAG(r4) ;At eof, was input from tty? ;05 beq getxit ;No, can't do more .if eq RMSIO bicb #10,F.BKP1+V$FDB(r4) ;Yes, clear FDB internal eof bit ;so user can call clearerr() and try ;the read again. getc() will test VF$EOF ;(which is already set) and return EOF ;until clearerr() is called. Then, we ;try to read again. .endc br getxit ;and exit ;04- .if ne RMSIO 20$: $FETCH R0,RSZ,R0 ;r0 == actual byte count ;11/12 .iff 20$: mov V$FDB+F.NRBD(R4),R0 ;R0 := actual byte count .endc ; ; Clean up the record (thank's to RSX cleverness) ; Enter with R0 := actual byte count getfix: bit #VF$NOS,V$FLAG(r4) ;Stream file? bne getxit ;If not, don't do newline stuff. mov r0,r1 ;Copy actual byte count add r2,r1 ;R1 -> record end movb #12,(r1)+ ;tack on a line feed inc r0 ;Count it, too ; ; Erase CR from CR/LF and LF/CR sequences. ; R0 := actual byte count ; R1 -> input buffer end ; R2 -> input buffer current byte ; R3 -> output buffer current byte ; 6(SP) input buffer start (r0 at call to $get) ; mov r2,r3 ;Start of output record 10$: cmp r2,r1 ;At the end? bhis getxit ;Exit if so tstb (r2) ;Null? beq 30$ ;Skip it if so. cmpb (r2),#15 ;Carriage return? bne 20$ ;No, go copy it cmpb 1(r2),#12 ;Carriage return, is next LF? beq 30$ ;Yes, ignore carriage return cmpb r3,6(sp) ;At start of output line? blos 20$ ;Yes, keep carriage return cmpb -1(r3),#12 ;No, is previous LF? beq 30$ ;Yes, ignore Carriage return ; 20$: movb (r2)+,(r3)+ ;Copy the byte br 10$ ;And get another ; 30$: inc r2 ;Skip over this byte dec r0 ;Erase from count, too br 10$ ;And get another ; ; Exit from $$get ; geterr: ;04 bis #VF$ERR,V$FLAG(R4) ;Error exit from $$get ;04/05 getxit: mov (sp)+,r3 ;Restore mov (sp)+,r2 ;Registers mov (sp)+,r1 ;R3 - R1 tst (sp)+ ;Keep actual byte count bit #VF$EOR,V$FLAG(r4) ;Error or end of file? ;05 beq 10$ ;Neither, exit mov #-1,r0 ;Yes, signal error 10$: return ;and exit .endc .if eq rsx ; ; RT11 ; .psect c$data REAERR: .BYTE E$$EOF, E$$ERR, E$$FAT .psect c$code .mcall .gtlin .rctrlo ;06 ; ; Get one block ; $$GET:: BIT #VF$TTY,V$FLAG(R4) ; we're called for the tty ;06+ BEQ 5$ ; Br if not .RCTRLO ; Refresh ^O to fix LC typein .GTLIN V$BASE(r4) ; Get the record BCS 25$ ; Oops call $$mchk MOV V$BASE(r4),r0 ; The record is terminated by EOS 3$: CMPB (R0),#'Z-0100 ; ^Z? BEQ 25$ ; EOF if so TSTB (r0)+ ; Look for EOS terminator ;09 BNE 3$ MOVB #12,-1(r0) ; Stuff a CLRB (r0) ; Terminate the record SUB V$BASE(r4),r0 ; r0 = number of bytes in buffer ;09 BR 10$ ; and exit 5$: ; Main sequence ;06- MOV R0,V$BNBR(R4) ; Fseek needs to refresh block number CLR -(SP) ; make an arg block for .READW MOV V$RBSZ(R4),-(SP) ; so the next block can be read ;05+ ASR (SP) ; Make it a word count MOV V$BASE(R4),-(SP) ; and record buffer ;05- MOV R0,-(SP) ; And the block number MOV #10 * 400,-(SP) ; .READW function BISB V$LUN(R4),(SP) ; channel MOV SP,R0 ; R0 -> arg block EMT 375 ; .READW BCS 20$ ; branch if the read failed MOV V$RBSZ(R4),R0 ; R0 = number of bytes in buffer ;09 MOV R0,V$BCNT(R4) ; Bytes to do in buffer ;05+ MOV V$BASE(R4),V$BPTR(R4) ; Free byte pointer INC V$BNBR(R4) ; bump blockno, it points to "next" ADD #5.*2,SP ; Clear stack ;05- ; 10$: RTS PC ; And exit ;07-- 20$: ADD #5*2,SP ; Clear the stack on errors 25$: MOVB @#52,R0 ; Get the error code ;06 ; $$GEOF:: ; Enter with MOV ERR_CODE,R0/JMP $$GEOF BEQ 10$ ; Br if end of file BIS #VF$ERR,V$FLAG(R4) ; Set error bit ;05 10$: BIS #VF$EOF,V$FLAG(R4) ; Always set eof bit ;05 MOVB REAERR(R0),$$FERR ; Save the error code MOV #-1,R0 ; Return EOF RTS PC ; And exit .endc .END -h- ioput.mac Thu Jan 19 14:37:01 1984 IOPUT.MAC;1 .title $$put Write a record -- RSX only .if ne RMSIO .ident "RMS006" .iff .ident /000006/ .endc ; ;+ ; ; Internal ; ; Index Write a logical record ; ; Usage ; ; mov #bufadr,r0 ;r0 -> buffer start ; mov nbytes,r1 ;r1 := number of bytes ; mov #iov,r4 ;r4 -> i/o vector ; call $$put ;Internal put buffer routine ; ; Return, r1..r4 preserved. ; ; Description ; ; $$put is called by RSX-mode routines to write a record. ; $$put only runs under the RSX library. Using it ; in RT11-mode will cause the job to abort with a BPT trap. ; The byte count may be zero for RSX Terminal I/O. ; ; If output is to a terminal, stderr will be flushed (first). ; ; Bugs ; ;- ; ; Edit history ; 000001 14-Oct-81 MM Split out from fflush.mac ; 000002 02-Jul-82 MM Newer library ; 000003 24-Jul-82 MM Fix extraneous newlines (ancient bug!) ; 000004 09-Sep-82 MM Flush stderr, too. ; 27-Oct-82 RBD Change comments only. Regarding initial ; setting of VF$NEWL on stdout/stderr. ; 000005 19-Dec-82 RBD Set null carriage control byte on terminal ; output in "n" mode. ; RMS006 17-Dec-83 RBD Add RMS-11 (V2) code for P/OS etc. ; .iif ndf rsx rsx = 1 ;Assume RSX11M .if ne rsx .if ne RMSIO .MCALL $PUT $STORE $FETCH $COMPARE ;06 .iff .MCALL PUT$ .endc .MCALL QIOW$S CR = 015 ; Carriage return ;03 LF = 012 ; Line feed ;03 .psect c$code ; ; Write a record. Calling sequence: ; ; MOV #BUFADR,R0 ;R0 -> first byte of buffer ; MOV NBYTES,R1 ;R1 := number of bytes to do ; MOV #IOV,R4 ;R4 -> I/O vector ; CALL $$PUT ; ; Return, all registers are preserved. ; ; Note: this routine understands newline stuff. It does real live ; QIO's on terminal devices. ; $$put:: jsr r5,$$svr1 mov r0,r2 ;Copy buffer address add r1,r2 ;Point to just past buffer bit #VF$TTY,V$FLAG(r4) ;Terminal device ;02 beq dodisk ;No, do a disk output cmp r4,stderr ;Is it stderr? beq 5$ ;yep, don't go forever. ;04+ mov r4,-(sp) ;save old r4 mov stderr,r4 ;get stderr call $$flsh ;flush it mov (sp)+,r4 ;restore our device 5$: ;main sequence ;04- ; ; You may be wondering what is happening here: ; The routines attempt to act reasonably on "real" terminals. ; The following code (which may well be a contender for the ; Guiness Book of Records "world's largest NOP") does the following: ; ; 1. If the user is controlling newlines directly, the carriage- ; control character is NULL. ; ; 2. Else, we control newlines. The VF$NEWL flag indicates whether ; the previous line ended with a newline: ; ; Carriage Control Character EOL VF$NEWL becomes ; NUL ... no 0 0 ; $ ... no 1 0 ; + ... yes 0 1 ; SP ... yes 1 1 ; ; 4. If a linefeed was erased from the record, and the record ; was or became empty, a dummy single-byte record is created ; as RSX gets unhappy only doing carriage control. ; ; 5. Finally, the monitor-level QIOW routine is called to output ; the record and appropriate carriage-control. All this work ; is then undone in the terminal service. ; ; VF$NEWL is erased by the scget() routine in screen.mac to prevent ; the "cursor" from moving when reading from the terminal after a prompt. ; bit #VF$NOS,V$FLAG(r4) ;User does all newline stuff? ;02 beq 10$ ;Branch if we do it tst r1 ;Was there anything? beq putxit ;Duck out if not. clr r2 ;Set NULL carriage control ;05 mov #IO.WAL,r3 ;Get the QIO operation -- write all. br 30$ ;Off we go ; 10$: mov #IO.WVB,r3 ;Write virtual block. mov #cctab,-(sp) ;CC table start bit #VF$NEWL,V$FLAG(r4) ;Was flag set? beq 12$ ;Br if not inc (sp) ;Yes, increment the flag 12$: bic #VF$NEWL,V$FLAG(r4) ;Ain't set now tst r1 ;Empty record? bne 13$ ;Continue if not mov #hack+1,r2 ;Get a legal address... 13$: cmpb -(r2),#LF ;Record ends with '\n'? bne 14$ ;Nope. add #2,(sp) ;Yes, step the flag and bis #VF$NEWL,V$FLAG(r4) ;set the flag for next time dec r1 ;Erase '\n' from the string 14$: movb @(sp)+,r2 ;Get the cc byte. tst r1 ;Is there a real record? bgt 30$ ;Output it if so. ;Strictly speaking this is ;incorrect as the count is unsigned. tst r2 ;But if it's a NULL cc, beq putxit ;Duck out. mov #hack,r0 ;Get the hack byte mov #1,r1 ;Force one byte record ; ; Here to do I/O. When we get here: ; R0 -> Output line ; R2 := EOL byte ; R1 := Byte count -- never zero ; R3 := QIO operation ; Somehow, I find it hard to believe that QIOW$S doesn't know that ; the LUN is a byte. ; 30$: movb V$LUN(r4),r5 ;Lun (R5 is restored by $$svr1) QIOW$S r3,r5,#1,,#$$iosb,, ;03- bcc putxit ;Common exit. bis #VF$ERR,V$FLAG(r4) ;Set error flag movb $$iosb,r0 ;Error code mov r0,$$ferr ;Saved br putxit ;and exit ;02- ; ; Do a normal file output ; dodisk: bit #VF$NOS,V$FLAG(r4) ;Never do linefeed? ;02 bne 10$ ;No, user does it. cmpb -(r2),#12 ;Linefeed terminated record? bne 10$ ;No, continue dec r1 ;Yes, erase it (FCS puts it back) 10$: mov r0,r2 ;Hide Buffer address from PUT$ mov r4,r0 ;Locate the FDB .if ne RMSIO add #V$RAB,r0 ;r0 --> RAB ;06+ $STORE R2,RBF,R0 ;Set buffer address $STORE R1,RSZ,R0 ;Set record length $PUT R0 $COMPARE #SU$SUC,STS,R0 beq putxit bis #VF$ERR,V$FLAG(R4) $FETCH R0,STS,R0 ;06- .iff add #V$FDB,r0 ;Now it's in R0 PUT$ r0,r2,r1 ;Write the record bcc putxit ;Normal exit from directive ;02+ bis #VF$ERR,V$FLAG(r4) ;Set error bit in IOV movb V$FDB+F.ERR(r4),r0 ;Error code .endc mov r0,$$ferr ;Store error code putxit: return ;And exit -- $$svr1 restores registers ;02- .psect c$strn ; ; Carriage control table. hack is used for the dummy record RSX needs. ;03+ hack: cctab: .byte 000 ; no , VF$NEWL == 0 .ascii "$" ; no , VF$NEWL == 1 ... .ascii "+" ; , VF$NEWL == 0 ... .ascii " " ; , VF$NEWL == 1 ... .even .iff ; ; Just in case ; $$put:: crash .endc ;03- .end -h- iov.mac Thu Jan 19 14:37:01 1984 IOV.MAC;1 .title iov I/O vector definition .if ne rmsio .ident "RMS017" .iff .ident /000017/ .endc ; ;+ ; ; Index I/O vector definition ; Index I/O error codes ; Index I/O system internal flags and vectors ; Index $$ferr -- File error value ; ; Usage ; ; #include ; ; ... to be supplied ... ; ; Bits in iov.io_flag: ; ; #define _IOREAD 0000001 /* read */ ; #define _IOWRT 0000002 /* write */ ; #define _IONBF 0000004 /* Unbuffered, "u" mode */ ; #define _IOMYBUF 000010 /* I/O lib. owns buffer */ ; #define _IOEOF 0000020 /* End of file seen */ ; #define _IOERR 0000040 /* Error seen */ ; #define _IOSTRG 0000100 /* For sprintf */ ; #define _IORW 0000200 /* Open for read/write */ ; #define IO_BZY 0000400 /* Buffer write needed */ ; #define IO_APN 0001000 /* Append mode open */ ; #define IO_NOS 0002000 /* No newlines needed */ ; #define IO_NEWL 0004000 /* RSX TTY newline hack */ ; #define IO_FIL 0010000 /* Disk file */ ; #define IO_TTY 0020000 /* Console terminal */ ; #define IO_REC 0040000 /* Record device */ ; #define IO_OPN 0100000 /* Open file */ ; #define IO_EOR (IO_ERR | IO_EOF) ; ; Bits in iov.io_wflag: ; #define IO_WLD 0000001 /* fwild: wildcard file */ ; #define IO_VM1 0000002 /* fwild: version ;-1 */ ; #define IO_VER 0000004 /* fwild: ;0 or ;-1 */ ; #define IO_WF1 0000010 /* fwild first flag */ ; #define IO_NLH 0000020 /* Newlines hack bit */ ; ; Bits in iov.io_rsflag (RSTS native only) ; #define IO_ODT2 0100000 /* ODT mode (RSTS only) */ ; ; extern int $$ferr; /* Error word */ ; extern FILE *stdin; /* Standard input file */ ; extern FILE *stdout; /* Standard output file */ ; extern FILE *stderr; /* User's command tty */ ; extern int $$exst; /* Exit status */ ; ; Internal ; ; extern FILE *$$luns[]; /* IOV pointer table */ ; extern FILE *$$lune; /* IOV table end */ ; extern (int)(char *$$lmax); /* RSX $$luns dim. */ ; extern char **$$ifil; /* -> stdin file name */ ; extern char **$$ofil; /* -> stdout file name */ ; extern int $$nlun; /* RSX: Number of luns */ ; FILE *$$eiov; /* RSX: Stderr iov */ ; extern int $$iosb[2]; /* RSX: I/O status */ ; ; Description ; ; Define the I/O vector structure used for communication by ; all I/O routines in the C library. Note that it is ; different for RSX and RT11 modes. Note also that certain bits ; in IO_FLAG are only meaningful for one flavor of I/O. ; ; The RSX-mode IOV contains an entire file data block (FDB). ; Also, 'io_uic' contains the binary UIC of the directory ; via which the file is being accessed, not the 'owner' UIC. ; It is this UIC which is given when fgetname() is called. ; ; The RT11-mode IOV contains only enough information to read and ; write files plus a pointer to an Ascii string with the file ; name argument to fopen(). The file name is needed for fgetname() ; and to allow deleting files given the IOV pointer. ; ; The following files are defined here: ; ; stdin The standard input file. ; ; stdout The standard output file. ; ; stderr The error output file. Note: on RSX ; systems, stderr is opened on LUN 1. ; ; $$ferr (error word) is also defined here. This is set non-zero ; if an error occurred when performing I/O. On RSX, the standard ; I/O error code is returned. On RT11, an error code compatible ; with RSTS/E usage is returned: ; ; Global Value Meaning ; E$$ILF 02. 002 Illegal file name ; E$$NOR 04. 004 No room for user on device ; E$$FNF 05. 005 Can't find file or account ; E$$NOD 06. 006 Not a valid device ; E$$ILU 07. 007 I/O channel in use ; E$$NOO 09. 011 I/O channel not open ; E$$EOF 11. 013 End of file on device ; E$$FAT 12. 014 Fatal system I/O failure ; E$$ERR 13. 015 User data error on device ; E$$FND 16. 020 File already found (protected) ; E$$NOC 17. 021 Too many open files on unit. ; E$$NSP 32. 040 No memory space for buffer ; ; E$$FAT (12) is set only if an "impossible" error occurs. While this ; may indicate a bug in the RT11 library, it is more likely to be ; a user programming error (like passing garbage to an I/O routine). ; ; E$$ILU (7) is set if fopen tries to open a channel that is already ; in use. ; ; The perror() library routine may be used to print an error message ; defined for the error code. ; ; $$exst (exit status) is used to transmit a termination code to ; the operating system. The value is set by calling exit() or ; exits(). The following exit status values are defined in stdio.h: ; ; Global #define RSX RT11 Meaning ; E$$XOK IO_SUCCESS 1 1 Normal ; E$$XWA IO_WARNING 0 2 Warning ; E$$XER IO_ERROR 2 4 Error ; E$$XFA IO_FATAL 4 8 Severe Error ; ; Internal ; ; In RSX, buffering is done by the RSX file-management services ; (FCS). The block buffer pointer is unused (but reserved for ; anybody who cares to add random access). ; ; Bugs ; ;- ; ; Edit history ; 000001 24-Jul-79 MM Initial edit ; 000002 11-Mar-80 MM Conversion for the newer C library ; 000003 18-Mar-80 MM Rewritten to add RT11 support ; 000004 10-Jun-80 MM Added VF$VER, VF$VM1, WF$MOD ; 000005 26-Jun-80 MM Added V$WILD ; 000006 27-Jun-80 MM Reorganized -- version numbers removed ; 000008 18-Jul-80 MM Added E$$ILU and E$$FND, redid globalization ; 000009 01-Aug-80 MM Removed VF$OUT, added VF$WF1, moved VF$OPN ; 000010 17-Aug-80 RBD Added IO_WLD/VF$WLD for RT-11 fwild() support. ; (VF$WLD is set for RSX wild-card files, too.) ; 000011 15-Sep-80 RBD Added IO_UIC/V$UIC to RSX IOV for proper UIC ; handling under native RSX. ; 000012 ?? ?? ; 000013 17-Feb-81 MM No newlines hack for wildcard files ; 000014 27-Jun-82 MM Major revision ; 000015 13-Aug-82 MM Added VF$NEWL ; 000016 29-Sep-82 MM Remove VF$BZY, Added VF$CMD ; RMS017 17-Dec-83 RBD Add conditional support for RMS-11(V2) ; .iif ndf rsx rsx = 1 ;Assume RSX .iif ndf rsts rsts = 0 ;Not native RSTS/E ; ; The IOV is the communication area for all I/O functions. ; Note that, when referred to by ASM routines (??????.S), ; "$" is written using the forbidden tilde. ; .if ne rsx .if ne RMSIO .mcall FAB$B FABOF$ RAB$B RABOF$ ;17+ .mcall NAM$B NAMOF$ XAB$B XABOF$ XABOF$ DEF$SZ RABOF$ DEF$SZ NAMOF$ DEF$SZ FABOF$ RMS$L ;17- .iff .mcall FDOF$L, FDBDF$, FDAT$A, FDRC$A, FDOP$A, NMBLK$ FDOF$L .endc .endc .psect c$data ; ; ; Some macros to simplify definition. ; .macro define start=0 $off$ = start .endm .macro int name, size=1 ; Define a global integer $ = size+size .iif ne <$ & 1> .error odd size for name name == $off$ ; Define name $off$ = $off$ + $ .endm int .macro allo name, value, size=1 $ = size+size .iif ne <$ & 1> .error odd size for name .iif ne .error bad allocation for name .if ne size .word value ; Allocate name = value .endc $off$ = $off$ + $ .endm .macro char name, size=1 ; Define a global character name == $off$ ; Define name $off$ = $off$ + size .endm char .macro bitmask name .iif eq $off$ .error name bit flag overflow .if nb name == $off$ .endc $off$ = $off$ + $off$ .endm bitmask ; ; Define the I/O vector offsets ; define ; ; This section is common to all implementations ; int V$BCNT ; _cnt free (or unread) bytes in buffer int V$BPTR ; _ptr -> next byte to read/write int V$BASE ; _base -> start of buffer int V$FLAG ; _flag I/O flags int V$WFLG ; io_wflag Wildcard flags int V$WILD ; io_wild Wildcard buffer int V$RBSZ ; io_rbsz Record buffer size in bytes ; ; This section is needed for RT11 (and RSTS) ; .if eq rsx int V$LUN ; io_lun Logical unit (channel) number int V$BNBR ; io_bnbr Block number int V$FSIZ ; io_size File size in blocks int V$NAME ; io_name File name char V$DBUF,size=2 ; io_dbuf[2] Dummy ungetc buffer .if ne rsts int V$RFLG ; io_rflag RSTS/E specific flags int V$RECM ; io_recm XRB@XRMOD modifier int V$WAIT ; io_wait XRB@XRTIME i/o wait time int V$BLKM ; io_blkm XRB$XRBLKM high-word block number .endc .iff ; ; RSX specific stuff ; int V$BBUF ; io_bbuf Block buffer (unused for now) int V$UIC ; io_uic File uic int V$DNAM ; io_dname Directory name string .if ne RMSIO char V$FAB,size=FB$BLN ; io_fab[] File access block ;17+ V$LUN == V$FAB+O$LCH ; LUN location in FAB. char V$NAM,size=NB$BLN ; io_nam[] Name block char V$RAB,size=RB$BLN ; io_rab[] Record access block char V$DAT,size=XB$DTL ; io_dat[] Date/time XAB char V$PRO,size=XB$PRL ; io_pro[] Proctection XAB ;17- .iff char V$FDB,size=S.FDB ; io_fdb[] File data block V$LUN == V$FDB+F.LUN ;LUN location in FDB. .endc .endc int V$SIZE,size=0 ; Size of complete iov ; ; Define flag bits ; define start=1 ; Bits in iov._flag bitmask VF$READ ; Open for input bitmask VF$WRT ; Open for output bitmask VF$NBF ; Unbuffered i/o 'u' flag to fopen bitmask VF$MBUF ; Buffer owned by i/o routines bitmask VF$EOF ; End of file seen bitmask VF$ERR ; Error seen bitmask VF$STRG ; String, used by sprintf() and scanf() bitmask VF$RW ; Read/write bitmask VF$CMD ; User's command terminal ;16 bitmask VF$APN ; 'a' option to fopen bitmask VF$NOS ; 'n' option to fopen bitmask VF$NEWL ; Newline hack -- see IOPUT.MAC ;15 bitmask VF$FIL ; Disk file bitmask VF$TTY ; Terminal ;16 bitmask VF$REC ; Record device bitmask VF$OPN ; Open file VF$EOR == VF$EOF+VF$ERR ;End of input mask ; ; The following bits are defined in iov.io_wflag (for wildcards) ; They must be in the low byte for RT11 (native) fwild to work. ; define start=1 bitmask VF$WLD ; Wild card file bitmask VF$VM1 ; Version ;-1 specified bitmask VF$VER ; Version ;0 or ;-1 specified bitmask VF$WF1 ; Wild card first flag bitmask VF$NLH ; Newlines hack bit .if ne rsts ; ; The following bit is used for the RSTS native library ; define start=100000 bitmask VF$ODT2 ; ODT mode .endc ; ; The error IOV is allocated statically ; .if ne rsx define $$eiov:: allo V$BCNT, $$esiz ; Buffer count allo V$BPTR, $$erec ; Buffer pointer allo V$BASE, $$erec ; Buffer start allo V$FLAG, ;16 allo V$WFLG, 0 ; Wild card flags allo V$WILD, 0 ; Wild card buffer allo V$RBSZ, $$esiz ; Buffer size allo V$BBUF, 0 ; Block buffer allo V$UIC, 0 ; UIC allo V$DNAM, 0 ; Directory name .if ne RMSIO allo V$FAB,size=0 ; FAB ;17+ $$efab:: fab$b ; File access block F$FNA $$efna ; File name string F$FNS $$efns ; File name size F$NAM $$enam ; File name block F$LCH 1 ; LUN 1 F$ORG FB$SEQ ; Sequential file F$RAT FB$CR ; CR/LF F$RFM FB$VAR ; Variable length records F$XAB $$edat ; Link to first XAB fab$e $off$ = $off$ + <.-$$efab> allo V$NAM,size=0 ; NAM $$enam:: nam$b N$ESA $$eesa ; Expanded string buffer address N$ESS $$eess ; Expanded string length nam$e $off$ = $off$ + <.-$$enam> allo V$RAB,size=0 ; RAB $$erab:: rab$b ; Record access block (RAB) R$FAB $$efab ; Address of FAB R$UBF $$erec ; User record buffer R$USZ $$esiz ; User record buffer size rab$e $off$ = $off$ + <.-$$erab> allo V$DAT,size=0 $$edat:: ; XAB (DAT) xab$b XB$DAT ; Date/time block declaration X$NXT $$epro ; Link to next XAB xab$e $off$ = $off$ + <.-$$edat> allo V$PRO,size=0 $$epro:: ; XAB (PRO) xab$b XB$PRO ; Protection block declaration X$NXT 0 ; End of XAB list xab$e $off$ = $off$ + <.-$$epro> ;17- .iff allo V$FDB,size=0 ; FDB $$efdb:: fdbdf$ ; File data block fdat$a r.var,fd.cr ; Vanilla file fdrc$a ; Use get/put fdop$a 1,,$$efnb ; Default filename, lun 1 $off$ = $off$ + <.-$$efdb> .endc .iff ; ; RT11 (and RSTS native) ; define $$eiov:: allo V$BCNT, 0 ; Buffer count allo V$BPTR, 0 ; Buffer pointer allo V$BASE, 0 ; Buffer start ;16-- allo V$FLAG, ;15/16 allo V$WFLG, 0 ; Wild card flags allo V$WILD, 0 ; Wild card buffer allo V$RBSZ, 0 ; Buffer size allo V$LUN, -1 ; Strange lun allo V$BNBR, 0 ; Block number allo V$FSIZ, 0 ; File size in blocks allo V$NAME, tty ; File name allo V$DBUF, 0 ; Ungetc buffer .if ne rsts allo V$RFLG, 0 allo V$RECM, 0 allo V$WAIT, 0 allo V$BLKM, 0 .endc .endc allo V$SIZE,size=0 ; Check size of complete iov .if ne rsx .if ne RMSIO $$EFNA:: ;17+ .ascii "TI:ERROUT.TXT" $$EFNS = .-$$EFNA $$EESA:: .BLKB 80. $$EESS = .-$$EESA .even ;17- .iff $$EFNB:: NMBLK$ ERROUT,TXT,,TI ; Default output to TI:ERROUT.TXT ; Note: on VMS, this is changed to ; CL:ERROUT.TXT by init.mac .endc .endc .if eq rsx ; ; Define Error codes for RT11 ; E$$ILF == 02. ;Illegal file name E$$NOR == 04. ;No room for user on device E$$FNF == 05. ;Can't find file or account E$$NOD == 06. ;Not a valid device E$$ILU == 07. ;I/O channel in use E$$NOO == 09. ;I/O channel not open E$$EOF == 11. ;End of file on device E$$FAT == 12. ;Fatal system I/O failure E$$ERR == 13. ;User data error on device E$$FND == 16. ;File already found E$$NOC == 17. ;Too many open files on unit. E$$NSP == 32. ;No memory space left .endc ; ; Define exit status codes ; .if ne rsx E$$XOK == 1 E$$XWA == 0 E$$XER == 2 E$$XFA == 4 .iff E$$XOK == 1 E$$XWA == 2 E$$XER == 4 E$$XFA == 8. .endc ; ; Allocate other file data ; $$ferr:: .word 0 ;Error control word .if ne rsx $$nlun:: .word 0 ;Number of luns .nluns:: .blkw 1 ;Set (by linker) to number of user luns $$iosb:: .word 0,0 ;Common i/o status block for library .endc $$ifil:: .word tty ;Stdin file name $$ofil:: .word tty ;Stdout file name $$erec:: .blkw 41. ;Stderr buffer (also used by GTSK) $$esiz == .-$$erec ;Error record size $$lmax == 20. ;Max number of user luns stdin:: .word 0 ;Stdin ioptr stdout:: .word 0 ;Stdout ioptr ; ; Note: stderr must be located just before $$luns ; as it is assigned to LUN 1 on RSX, and to channel -1 on RT11 ; $$luns[0] is LUN 2 on RSX, and channel 0 on RT11 ; stderr:: .word $$eiov ;Stderr ioptr (lun 1 or -1) $$luns:: .blkw $$lmax ;Ioptrs on a per lun basis $$lune == . ;End of Ioptr table tty: .if ne rsx .asciz /ti:/ ;Standard (command) input/standard output .iff .asciz /tt:/ ;Standard input/standard output .endc .END -h- mygsa.mac Thu Jan 19 14:37:01 1984 MYGSA.MAC;1 .title $$gsa Get-space routine .ident /RMS001/ .enabl lc ; ;+ ; ; Index RMS Get-space routine ; ; Usage ; ; Internal ; ; Inputs: ; r0 --> pool free-space list (not used) ; r1 = size (bytes) of requested/released block ; r2 = 0 if allocating a block, address of first ; word being released if deallocating. ; ; Outputs: ; Successful allocation: ; C-bit cleared and R0 --> allocated block ; Unsuccessful allocation: ; C-bit set ; Deallocation: ; Nothing returned ; ; Description ; ; RMS-11 pool management routine. Used to allocate and deallocate ; space to meet the needs of RMS-11 operations. ;- ; Edit History ; 000001 03-Feb-83 TTC Initial edit ; RMS001 17-Dec-83 RBD Touched it 's all. ; .psect c$code $$gsa:: mov r2,r0 ; Allocation or deallocation requested? beq 10$ ; Branch if allocation call $$free ; otherwise, free the block return ; and return. 10$: mov r1,r0 ; r0 = number of bytes to allocate add #3,r0 ; Round up to 4-byte boundary ;01 bic #3,r0 ;01 call $$aloc ; allocate core tst r0 ; Error? beq 20$ ; (Yes), branch. clc ; (No), clear carry bit return ; and return. 20$: sec ; Error, so set carry bit return ; and return. .end -h- perror.mac Thu Jan 19 14:37:01 1984 PERROR.MAC;1 .title perror Print Library Error Message .if ne rmsio .ident "RMS005" .iff .ident /000005/ .endc ; ;+ ; ; Index Print library error message ; ; Usage ; ; perror(text) ; char *text; ; ; Description ; ; An error message is written to stderr, using the ; current i/o library error (stored in $$ferr). ; Text is prepended to the message. ; ; Diagnostics ; ; Bugs ; ;- ; ; Edit history: ; 000001 22-Oct-81 MM Written ; 000002 19-Jan-82 MM Fixed up RT11 stuff ; 000003 19-Jan-82 MM Really fixed it ; 000004 26-Mar-82 MM Typo's in .psect's ; RMS005 17-Dec-83 RBD Add RMS-11(V2) .iif ndf rsx rsx = 1 ;Assume RSX11M $str$ = 0 .list meb .nlist bex .if ne rsx .macro m r, t, str .if nb r $str$ = $str$+1 .irp $,<\$str$> .psect c$data ;02+ .word r,s'$ .psect c$strn ;04 s'$ = . .endr .asciz str .endc .endm m .iff .macro m r, t, str .if nb t ;03 $str$ = $str$+1 .irp $,<\$str$> .psect c$data ;02+ .word t,s'$ ;03 .psect c$strn ;04 s'$ = . .endr .asciz str .endc .endm m .endc ; ; Define the error message table ; .psect c$data errtable: .if eq rmsio m , e$$ilf, <"Illegal file name"> m ie.bad, , <"File system error"> m ie.bnm, , <"Illegal file name"> m ie.dfu, e$$nor, <"No room for file"> m ie.nsf, e$$fnf, <"File not found"> m ie.bdv, e$$nod, <"Bad device name"> m ie.aln, e$$ilu, <"I/O channel in use"> m ie.nln, e$$noo, <"I/O channel not open"> m ie.eof, e$$eof, <"End of file"> m ie.fhe, e$$fat, <"Fatal system I/O error"> m ie.rer, e$$err, <"Device error"> m ie.fex, e$$fnd, <"File already present"> m ie.ilu, e$$noc, <"Too many open files"> m ie.lck, , <"File locked"> m ie.nbf, e$$nsp, <"No memory space available"> m ie.pri, , <"No access to file"> m ie.rbg, , <"Illegal record size"> .iff ; ; Codes for RMS-11(V2) -- RSX & P/OS only ; m er$dev, , <"Bad device name"> m er$fnm, , <"Bad file name"> m er$typ, , <"Bad file extension"> m er$dir, , <"Bad directory name"> m er$ver, , <"Bad version number"> m er$ful, , <"No room for file"> m er$dnf, , <"Directory not found"> m er$fnf, , <"File not found"> m er$wlk, , <"Device write locked"> m ie.aln, , <"I/O channel in use"> m ie.nln, , <"I/O channel not open"> m er$eof, , <"End of file"> m ie.ver, , <"Device error"> m er$fex, , <"File already present"> m ie.ilu, , <"Too many open files"> m ie.nbf, , <"No memory space"> m er$prv, , <"No access to file"> m er$rtb, , <"Record too big"> m er$irc, , <"Illegal record size"> .endc .psect c$data ;04 .word 0, 0 ;terminate buffer ; ; Format strings ; .psect c$strn ;04 normal: .asciz "%s: %s"<12> unknown: .asciz "%s: Unknown error %06o %d."<12> noerror: .asciz "%s: No current error"<12> .even .psect c$code perror:: jsr r5,csv$ ;Link environments mov $$ferr,(sp) ;Get error code bne 10$ ;Continue if there is one mov C$PMTR+0(r5),(sp) mov #noerror,-(sp) br print 10$: mov #errtable,r4 ;start at the table 20$: cmp (sp),(r4)+ ;is it ours? beq 30$ ;yes, exit loop tst (r4)+ ;no, is it the end bne 20$ ;continue if not. ; ; Unknown error ; mov (sp),-(sp) ;duplicate $$ferr mov C$PMTR+0(r5),-(sp) mov #unknown,-(sp) br print ; ; Gotcha ; 30$: mov (r4),(sp) ;Here's the text mov C$PMTR+0(r5),-(sp) ;And the argument mov #normal,-(sp) ;And the format print: mov stderr,-(sp) ;Where to output text call fprintf ;Put out message jmp cret$ ;and try for more .end -h- rmrsx.mac Thu Jan 19 14:37:01 1984 RMRSX.MAC;1 .title rsx rsx header file ; ; Version of 17-Oct-82 ; RSX = 1 ;Assemble for RSX VMS3.0 = 0 ;DO NOT Assemble vms release-specific code C$$SXT = 1 ;Assume SXT, SOB instructions ;Note: set C$$SXT = 0 for 11/04, 11/05, ; 11/20 and 11/40 without EIS. C$$EIS = C$$SXT ;Assume inline EIS if C$$SXT. This ; may be overridden at compile time. C$$FLT = 0 ;Assume double precision N$$FIL = 8. ;For the RSX run-time library, ;Default to 8 simultaneously open files. ;Note: change this to allocate block buffers. RMSIO = 1 ;Assemble for RMS C$PMTR = 4 ;Locally define C$PMTR and C$AUTO C$AUTO = -6 ;To minimize global symbol references XASCII = 1 ;Extended (8-bit) Ascii ; ; Uncomment the following if you want the compiler to generate ; the old default P-section names (".prog.", etc.). BE SURE YOU ; REALLY WANT THIS. IT IS INCOMPATIBLE WITH THE CURRENT LIBRARY!! ; ;;;OLDPSC = 1 .IIF NDF L$$IST .NLIST .IIF NDF L$$IST .DSABL CRF .IIF NDF C$$SXT C$$SXT = 0 ; No SXT, SOB .IIF NDF C$$EIS C$$EIS = 0 ; No EIS .IIF NDF XASCII XASCII = 1 ; Allow extended Ascii .MACRO CALL ARG1,ARG2 .IF B ARG2 JSR PC,ARG1 .IFF JSR ARG1,ARG2 .ENDC .ENDM CALL .MACRO CALLR ARG1 JMP ARG1 .ENDM CALLR .MACRO RETURN ARG1 .IF B ARG1 RTS PC .IFF RTS ARG1 .ENDC .ENDM RETURN ; ; The null branch macro ; .macro .br label .iif ndf label .error label argument needed .iif ne .-label .error label must be the next location .endm .br ; ; The .sob macro is like an sob but does not set condition codes correctly ; since it is a dec/bne when sob isn't available. ; .IF EQ C$$SXT .MACRO .SOB ARG1,ARG2 DEC ARG1 BNE ARG2 .ENDM .SOB .IFF .MACRO .SOB ARG1,ARG2 SOB ARG1,ARG2 .ENDM .SOB .ENDC ; ; This macro defines the crash instruction ; .MACRO CRASH .LIST BPT .NLIST .ENDM CRASH ; ; Check an assumption. Use this macro as follows: ; ; ASSUME ARG1 COND ARG2 ; ; An error will be signalled unless the condition is satisfied. ; COND may be one of: EQ,NE,GT,GE,LT,LE,DF,NDF,B,NB,Z,NZ,G,L, ; but it may not be IDN or DIF. ; .MACRO ASSUME ARG1,COND,ARG2 .IF COND - .IFF .ERROR ;Invalid assumption (ARG1) COND (ARG2) .ENDC .ENDM .ENABL LC, GBL .NLIST CND, BEX .IIF NDF L$$IST .ENABL CRF .IIF NDF L$$IST .LIST -h- tomartin.inf Thu Jan 19 14:37:01 1984 TOMARTIN.INF;1 Martin: Tim mistakenly used our hacked fwild.mac as the baseline for the RMS stuff. There are only a few lines difference, mostly concerned with calling $$fcsi instead of our junk. The easiest approach to fixing it for FCS is to diff it and see what has changed outside the RMSIO conditionals. It assembles normally (?) for RMS though. -h- vmakcr.com Thu Jan 19 14:37:01 1984 VMAKCR.COM;21 $! VMAKCR.COM $! $! Make RMS run-time library for C programs. $! This command file requires an existing OU:C.OLB. It $! replaces modules which have been changed for RMS $! $! Note that there is a further change to CR.OLB for P/OS $! in the CTEXLIB directory. Files in this library (should) $! be suitable for any rms-only system. $! $! Assignments: $! OU: C: Library output $! SR: [] Source files $! $! The following hack is needed because I normally $! point lb: to sys$library: $! $ foo = "''f$logical("LB")'" $ if foo .nes. "" .and. "''f$extract(0,1,foo)'" .nes. "_" then - deassign lb: $! $ was_verify = 'f$verify(1) $ assign lb:[001,005] rms: $ assign C: ou: $ assign 'f$logical("SYS$DISK")''f$directory()' sr: $! $ goto foo $ copy ou:c.olb ou:cr.olb ! Initialize library $ mcr pma delete=rms:rmsmac/ml,sr:rmrsx,sr:delete $ mcr lbr ou:cr=delete/rp $ mcr pma fclose=rms:rmsmac/ml,sr:rmrsx,fclose $ mcr lbr ou:cr=fclose/rp $ mcr pma fgetna=rms:rmsmac/ml,sr:rmrsx,fgetna $ mcr lbr ou:cr=fgetna/rp $ mcr pma fopen=rms:rmsmac/ml,sr:rmrsx,fopen $ mcr lbr ou:cr=fopen/rp $ mcr pma fpar=rms:rmsmac/ml,sr:rmrsx,fpar $ mcr lbr ou:cr=fpar/rp $ mcr pma fseek=rms:rmsmac/ml,sr:rmrsx,fseek $ mcr lbr ou:cr=fseek/rp $ mcr pma ftell=rms:rmsmac/ml,sr:rmrsx,ftell $ mcr lbr ou:cr=ftell/rp $ mcr pma fwild=rms:rmsmac/ml,sr:rmrsx,fwild $ mcr lbr ou:cr=fwild/rp $ mcr pma init=rms:rmsmac/ml,sr:rmrsx,init $ mcr lbr ou:cr=init/rp $ mcr pma ioget=rms:rmsmac/ml,sr:rmrsx,ioget $ mcr lbr ou:cr=ioget/rp $ mcr pma ioput=rms:rmsmac/ml,sr:rmrsx,ioput $ mcr lbr ou:cr=ioput/rp $ mcr pma iov=rms:rmsmac/ml,sr:rmrsx,iov $ mcr lbr ou:cr=iov/rp $ mcr pma mygsa=rms:rmsmac/ml,sr:rmrsx,mygsa $ mcr lbr ou:cr=mygsa/rp $ mcr pma perror=rms:rmsmac/ml,sr:rmrsx,perror $ mcr lbr ou:cr=perror/rp $ foo: $! $! Now, build the PRO-350 version of cr. $! $ copy ou:cr.olb [-]crpro.olb $ assign [-.ctexlib] cr: $ mcr pma pfspool=rms:rmsmac/ml,sr:rmrsx,cr:pfspool $ mcr lbr [-]crpro=pfspool/rp $! $ delete *.obj;* $ if 'was_verify' .eq. 0 then set noverify $ exit