github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-07 11:17:06 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/amis/dskio.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

1758 lines
52 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE DSKIO - Disk I/O routines for editor AMIS -*-Macro-*-
SEARCH UUOSYM,MACTEN
t0==0
t1==1
t2==2
t3==3
t4==4
t5==5
t6==6
t7==7
t8==8
p==17
dsk==2 ;Channel for disk I/O.
dsksize==^D640 ;Size of disk block, in chars.
strsize==^D40
opdef call[ pushj p,]
define bugerr(msg),<
jrst[ movei 2,[
asciz "'msg'"]
pushj p,bug##]
>;End of bugerr macro.
define DBP(ac,%lbl),< ;Decrement Byte Pointer
caml ac,[35b5]
jrst[ sub ac,[340000,,1]
jrst %lbl]
add ac,[7b5]
%lbl:
>;End of DBP macro
TWOSEG 600000 ;make a shareable highsegment
;=============================================================================
;PROCEDURE dskinit;
;
;(* Initialises the DSKIO-module *)
dskini::SETZM ds.opn ; no files open yet
SETZM proflg ; no funny renameing done yet
SETZM notdir ; no device checks yet
SETZM tcrflg ; we haven't fiddled
SETZM tcrdev ; with TMPCORE yet
setzm prsarg ; No parameters from TMP:EDS yet.
; Make a temporary filename based on the jobnumber.
PJOB t1, ; get our job number
IDIVI t1,^D100 ; I don't really want to explain..
IDIVI t2,^D10 ; ..this code sequence...
ROT t2,-6
ROTC t1,-6
TLO t2,'000'(t3)
TRO t2,'AMI' ; ...
MOVEM t2,tmpnam ; store it
POPJ P,
;=============================================================================
;PROCEDURE blankstring (VAR txt: STRING);
;
;(* Blanks the string 'txt' *)
txt==2
blanks: push p,t1 ;Save T1.
move t1,[BYTE (7) " "," "," "," "," "]
movem t1,(txt) ;Blank first word
HRLZ t1,txt ;get pointer to string
HRRI t1,1(txt)
BLT t1,strsiz/5-1(txt) ; blank the string
POP p,t1
POPJ P,
;==============================================================================
; This routine is called upon initialization to rescan the command line.
rrspar::setzm rsccnt ;No chars rescanned yet.
rescan 1 ;Try rescan the command line.
skipa ; OK, start parsing.
popj p, ; Not OK, just return.
setz t4, ;Clear word.
move t5,[point 6,t4] ;Load byte pointer.
movei t6,6 ;Load char count.
rrs.2: pushj p,rrsgch ;Try get a character.
popj p, ; No more, give up.
caie t1," " ;Loop until some non-blank char.
cain t1,.chtab
jrst rrs.2
rrs.3: cail t1,"0" ;While char is alphanumeric, collect word.
caile t1,"9"
cail t1,"A"
caile t1,"Z"
cail t1,"a"
caile t1,"z"
jrst rrs.5
sojl t6,rrs.4
cail t1,"a"
subi t1,40
subi t1,40
idpb t1,t5
rrs.4: pushj p,rrsgch ;Get next char of word.
tdza t1,t1 ; No more, flag in T1 and skip.
jrst rrs.3
rrs.5: came t4,['A '] ;Do we know this initial command?
camn t4,['AM ']
jrst rrs.8
came t4,['AMI ']
camn t4,['AMIS ']
jrst rrs.8
jumpe t1,.popj ;No, quit if this was eol.
rrs.6: caie t1,"!" ;Not eol, scan for comment start or "-".
cain t1,";"
jrst read6c
cain t1,"-"
jrst rrs.7
pushj p,rrsgch
popj p,
jrst rrs.6
read6c: pushj p,rrsgch ;We found a command, skip to eol.
popj p,
jrst read6c
rrs.7: pushj p,rrsgch ;Found a hyphen, eat it and use rest.
popj p,
rrs.8: setom offset## ;'AMIS' started command, flag it.
jumpe t1,.popj ;Allow eol after command.
caie t1," " ;Start of arguments -- skip leading blanks.
cain t1,.chtab
jrst rrs.7
move t5,[point 7,tcrbuf+1]
rrs.9: idpb t1,t5
aos rsccnt
pushj p,rrsgch
skipa t1,[ascii "AMIS "]
jrst rrs.9
movem t1,tcrbuf+0 ;Store initial part of TMP:EDS
movei t1,^D13 ;Terminate file with CRLF.
idpb t1,t5
movei t1,^D10
idpb t1,t5
setzm offset## ;No need to read the file we just wrote...
movsi t0,'EDS' ;Load tempcore file name.
move t1,rsccnt ;Get count of bytes rescanned.
addi t1,5+4+2 ;Add one word, two chars and adjustment.
idivi t1,5 ;Compute number of words.
movn t1,t1 ;Negate.
hrl t1,t1 ;Put in left half.
hrri t1,tcrbuf-1 ;Make IOWD to buffer.
movx t2,<.tcrwf,,t0>
tmpcor t2, ;Write TMP:EDS
jfcl ; Oh well...
popj p, ;Done with all this junk.
rrsgch: inchwl t1 ;Get a character.
movei t0,1B35 ;Load a bit.
lsh t0,(t1) ;Shift according to character.
trne t0,^B10000000000001;Ignore CR and NULL.
jrst rrsgch
tdnn t0,[^B1100000101000001110010001000]
aos (p)
popj p,
;=============================================================================
;function GetParameters: boolean;
;
;(* Reads TMP:EDS and prepares for special things. *)
getpar::skipe offset## ;Check runoffset.
jrst getpa0 ; Set, look for and read TMP:EDS
hrlz t1,rsccnt ;Zero, check what we rescanned.
jumpe t1,retf ;Nothing, tell MAIN the fact.
hrri t1,tcrbuf+1 ;Something, make len,,addr.
movem t1,prsarg ;Set up for DSKOPEN
jrst rett ;Return true.
getpa0: MOVSI t3,'EDS' ; read from TMP:EDS
HRLZI t4,-50 ; negative count of words in buffer
HRRI t4,tcrbuf-1 ; addr-1 to buffer
MOVE t1,[.TCRRF,,t3]
TMPCOR t1,
jrst retf ; No tmp:eds maybe.
MOVE t3,[POINT 7,tcrbuf]
IMULI t1,5
;come here to find first blank or <TAB>
getpa1: jumple t1,retf ;Abort now if no chars left.
ILDB t4,t3
CAIE t4," "
CAIN t4,.CHTAB
SOJA t1,getpa2
soja t1,getpa1
;now scan past all blanks or <TAB>s
getpa2: jumple t1,retf
ILDB t4,t3
CAIE t4,.CHTAB
CAIN t4," "
SOJA t1,getpa2
;come here to shift the string to the left
move t5,[POINT 7,tcrbuf]
tdza t6,t6
getpa3: ildb t4,t3
caie t4,.chcnv ;^V?
cail t4," " ; No, other control char?
cail t4,177 ; or rubout?
jrst quit ; Terminator.
idpb t4,t5
addi t6,1 ;Count chars moved.
sojg t1,getpa3
quit: jumpe t6,retf ;No chars moved means no parameters.
hrli t6,tcrbuf ;set up swapped pointer.
movsm t6,prsarg ;store.
jrst rett
retf: tdza t1,t1
rett: movei t1,1
movem t1,1(p)
popj p,
;=============================================================================
;FUNCTION filprs(n: STRING; lkb:LOOKUP/ENTER/RENAME-block): INTEGER;
;
;(* Local function to parse a filespec.
; Returns the following "error" codes in ac0: *)
errnoe==101 ; no error, success
erricf==102 ; illegal character in filspec.
errtlf==103 ; too long field in filespec.
errdfn==104 ; duplicate filename
errdex==105 ; duplicate extension
errddr==106 ; double directory
errcnd==107 ; colon, but no device
errddv==110 ; duplicate device
errils==111 ; illegal separator in directory
errtms==112 ; too many sfds
errnls==113 ; null sfd
errilf==114 ; illegal format for directory
errilp==115 ; illegal protection code
errdpr==116 ; duplicate protection
errnw8==117 ; cant write 8-bit files.
;parameters
n==2
lkb==3
;locals
flags==0
pos==4
separ==5
word==6
sfdpnt==7
pth==10
err==11
X==7 ;Duplicate use of these.
NUMB==10
;filespec. flags
f.dev==1B35 ; device found
f.nam==1B34 ; file name found
f.ext==1B33 ; extension found
f.dir==1B32 ; directory found
f.pro==1B31 ; protection found
filprs: SETZ flags, ; clear flag word
PUSH p,pos ; save some accumulators
PUSH p,separ
PUSH p,word
PUSH p,sfdpnt
PUSH p,pth
PUSH p,err
SETZM cvseen ; no CTRL-V seen yet
SETZM PG.VAL ;[JE] No /Page yet.
SETZM LN.VAL ;[JE] No /Line yet.
SETZM CH.VAL ;[JE] No /Char yet.
SETZM FLAG8 ;[JE] No bytesize yet.
HLRZM n,prslen ;[JE] save string length.
HRLI n,(POINT 7,0) ; set up bytepointer to string
MOVEI pos,1 ; pos points to first char in n
filpr1: CALL nxtsix ; get next sixbit char
JRST .firet ; illegal character
JUMPL separ,.finrt ; end of string
filpr2: DBP n ; decrement byte pointer
SUBI pos,1 ; reset pos to last read char
CALL nxtwrd ; get a sixbit word
JRST .firet ; too long field
CAIN separ,':' ; is it device?
JRST fildev ; yes
JUMPE word,filpr3 ; if null, not filename
MOVEI err,errdfn ; assume double filenam error
TROE flags,f.nam ; check double filename error
JRST .firet ; yes, duplicate filename error
MOVEM word,.RBNAM(lkb) ; save filename
filpr3: CAIN separ,'.' ; is it extension?
JRST filext ; yes
CAIN separ,'<' ; protection or directory?
JRST filpro ; see if protection
CAIN separ,'[' ; directory?
JRST fildir ; yes
JUMPLE separ,.finrt ; at end of string?
MOVEI err,erricf ; no, we don't recognise it
JRST .firet
; here if "<" seen - check if it is protection
filpro: MOVEM n,save.n ; save position in
MOVEM pos,savpos ; name string
CALL nxtoct ; get prortection code
JRST .firet ; error
CAIE separ,'>' ; was it protection?
JRST[ MOVE n,save.n ; no, try directory instead
MOVE pos,savpos
JRST fildir]
MOVEI err,errdpr ; assume duplicate protection
TROE flags,f.pro ; duplicate?
JRST .firet ; yep
MOVEI err,errilp
CAILE word,777 ; check if legal
JRST .firet ; illegal
DPB word,[POINT ^D9,dslkbk+.RBPRV,^D8] ; store protection code
JRST filpr1 ; back for next field
; here if colon seen - we should have a device
fildev: MOVEI err,errilf ; assume illegal format
TRNE flags,f.nam+f.ext+f.dir ; device must be first in spec.!!
JRST .firet
JUMPE word,[
MOVEI err,errcnd ; no device before colon, error
JRST .firet]
MOVEI err,errddv ; assume double device error
TROE flags,f.dev
JRST .firet ; yes, duplicate device
MOVEM word,dsopbk+.OPDEV ; save device
DEVCHR word, ; what kind of device?
TXNE word,DV.DIR ; directory device?
JRST filpr1 ; yes, go back for more
SETOM notdir ; it was not a directory device
JUMPN word,filpr1 ; but it was a device
MOVE word,dsopbk+.OPDEV ; see if it was TMP:
CAXN word,SIXBIT /TMP/ ; tmpcore?
SETOM tcrdev ; yes, remember it
JRST filpr1
; here if period seen - next word should be extension
filext: MOVEI err,errdex ; assume duplicate extension
TROE flags,f.ext ; check for double extension
JRST .firet ; yes, double extension
CALL nxtwrd ; get next sixbit word
JRST .firet ; too long field
HLLM word,.RBEXT(lkb) ; save extension
JUMPG separ,filpr2 ; go back for more, if there is any
JRST .finrt ; ok, we're finished
; here if left bracket seen - directory should come next
fildir: SKIPE notdir ; directory device?
JRST fild.1 ; no, don't check default path
MOVE pth,.RBPPN(lkb) ; get pointer to PATH.-block
MOVE separ,dsopbk+1 ; get device
MOVEM separ,.PTFCN(pth) ; put device in PATH.-block
HRLI pth,.PTMAX
MOVEI err,ERDNA% ; assume device not available
PATH. pth, ; find out default path for this device
JRST .firet ; yep, it wasn't there
GETPPN word, ; get job's PPN (*JMR*)
JFCL ; (*JMR*)
MOVEM word,.PTPPN(pth) ; save PPN
fild.1: MOVEI err,errddr ; assume duplicate directory
TROE flags,f.dir ; check duplicate directory error
JRST .firet ; yes, duplicate directory
CALL nxtoct ; read an octal number (project)
JRST .firet ; error, too long field
CAIE separ,'-' ; default directory?
JRST fildr1 ; no, proceed
CALL nxtsix ; get next char
JRST .firet ; error, illegal char
JRST fildr3 ; finish directory parsing
fildr1: SKIPE word ; null project?
HRLM word,.PTPPN(pth) ; no, save project
MOVEI err,errils ; assume illegal separator in directory
CAIE separ,',' ; check it
JRST .firet ; yes, illegal separator
CALL nxtoct ; read an octal number (programmer)
JRST .firet ; error, too long field
SKIPE word ; null programmer?
HRRM word,.PTPPN(pth) ; no, save programmer
MOVEI sfdpnt,.PTSFD(pth) ; set pointer to first sfd
fildr2: CAIE separ,',' ; sfd next?
JRST fildr3 ; no, finish directory parsing
MOVEI err,errtms ; assume too many sfds
CAIL sfdpnt,.PTMAX(pth) ; how many sfds now?
JRST .firet ; too many
CALL nxtwrd ; get next sixbit word
JRST .firet ; too long field
MOVEM word,(sfdpnt) ; save the sfd
ADDI sfdpnt,1 ; increment sfd-pointer
JUMPN word,fildr2 ; if not null sfd, get next
MOVEI err,errnls ; null sfd, illegal
JRST .firet
fildr3: SETZM (sfdpnt) ; null word must be last in path
MOVEI err,errilf ; assume illegal format for directory
JUMPLE separ,filpr1 ; hack to allow missing right bracket
CAIE separ,']' ; must be at end of directory
CAIN separ,'>' ; check end of 2741 directory too
JRST filpr1 ; back for next field
JRST .firet ; yep, it was error all right
.finrt: MOVEI err,errnoe ; return success
SKIPE notdir ; is it a directory device?
JRST .firet ; no
TRNN flags,f.dir ; directory found?
SETZM .RBPPN(lkb) ; directory wasn't seen, use default
TRNE flags,f.pro ; protection found?
JRST .firet ; yep
MOVX t1,<-1,,.GTDFL>
GETTAB t1, ; find out default protection
SETZ t1, ; that should give us default later
TXNN t1,JD.SDP ; did user set default prot?
JRST[ MOVX t1,%LDSTP ; no, get system default
GETTAB t1,
MOVX t1,057B8 ; well...
JRST .+1]
LDB t1,[POINT ^D9,t1,^D8] ; extract prot.
DPB t1,[POINT ^D9,dslkbk+.RBPRV,^D8] ; store it
.firet: MOVE t0,err ; return error code
POP p,err ; restore some accumulators
POP p,pth
POP p,sfdpnt
POP p,word
POP p,separ
POP p,pos
POPJ P,
;get next sixbit char
;skip return if succesful, with char in ac 'separ',
; negative "char" if end of string.
;nonskip return if failure, with error code in 'err'
nxtsix: CAMLE pos,prslen ; past last char?
JRST[ SETO separ, ; yes, return negative "char"
JRST .nsret]
ILDB separ,n ; get next ascii char
CAIL separ,"a"
CAILE separ,"z"
SKIPA
SUBI separ," " ; convert to capitals
CAIL separ," " ; is char in sixbit range?
CAILE separ,"_"
JRST[ MOVEI err,erricf ; assume it's illegal
CAIE separ,"V"-"@" ; is it CTRL-V?
POPJ P, ; no it isn't, sorry
SKIPE cvseen ; CTRL-V already typed?
JRST[ SETZM cvseen ; yes, sorry
POPJ P,]
SETOM cvseen ; set the CTRL-V flag
ADDI pos,1 ; we have read on more char
JRST nxtsix ; ignore this char and get next
]
SUBI separ," " ; convert to sixbit
ADDI pos,1 ; increment pos
CAIE separ,'/' ;[JE] Attempt to read switches.
JRST .nsret ;[JE] Normal char, return.
PUSHJ P,SWTCHK ;[JE] Check for switches.
SETO separ, ;[JE] Call this end of string.
.nsret: AOS (p) ; bump return address
POPJ P,
; Here to check for switches. Don't look too close...
swtchk: push p,word ;Save current word.
push p,t7 ;Save this one too.
swtlup: pushj p,atom ;Read an atom.
camn word,['8 '] ;Want eight bit bytes?
jrst sw.8bt ; Yes, go handle.
camn word,['I '] ;Want I*M eight bits?
jrst sw.ibm ; Yes, go handle.
caie separ,':' ;Terminated by colon?
jrst swtret ; No, then we don't know about it.
came word,['P '] ;/P?
camn word,['PA '] ; /Pa?
jrst sw.page ; Yes, go handle.
came word,['PAG '] ;/Pag?
camn word,['PAGE '] ; /Page?
jrst sw.page ; Yes, go handle.
came word,['L '] ;/L?
camn word,['LI '] ; /Li?
jrst sw.line ; Yes, go handle.
came word,['LIN '] ;/Lin?
camn word,['LINE '] ; /Line?
jrst sw.line ; Yes, go handle.
came word,['C '] ;/C?
camn word,['CH '] ; /Ch?
jrst sw.char ; Yes, go handle.
came word,['CHA '] ;/Cha?
camn word,['CHAR '] ; /Char?
jrst sw.char ; Yes, go handle.
came word,['R '] ;/R?
camn word,['RU '] ; /Ru?
jrst sw.run ; Yes, go handle.
camn word,['RUN '] ;/Run?
jrst sw.run ; Yes, go handle.
swtret: pop p,t7
pop p,word
popj p,
; Here to handle /8 and /I
sw.ibm: skipa numb,["I"]
sw.8bt: movei numb,"8"
movem numb,flag8
jrst swtlup
; Here to decode /Page
sw.pag: pushj p,decnum ;Get decimal argument.
movem numb,pg.val ;Store argument.
jrst swtlup ;Loop for more.
; Here to decode /Line
sw.lin: pushj p,decnum ;Get decimal argument.
movem numb,ln.val ;Store argument.
jrst swtlup ;Loop for more.
; Here to decode /Char.
sw.cha: pushj p,decnum ;Get decimal argument.
movem numb,ch.val ;Store argument.
jrst swtlup ;Loop for more.
; Here to decode /Run.
sw.run: MOVEI X,6 ;Load a loop counter.
SETZM RUNBLK-1(X) ;Clear a word.
SOJG X,.-1 ;Loop over them all.
RUNLUP: PUSHJ P,ATOM ;The rest should be obvious.
CAIN SEPAR,':'
MOVEI X,4
XCT STATE(X)
TDZA X,X
MOVEM WORD,RUNFIL
JUMPLE SEPAR,swtret ;Restore and return after all is done.
CAIN SEPAR,'.'
AOJA X,RUNLUP
CAIE SEPAR,'<';'>'
CAIN SEPAR,'[';']'
MOVEI X,2
CAIN SEPAR,','
MOVEI X,3
JRST RUNLUP
STATE: SKIPE RUNFIL
HLLZM WORD,RUNEXT
HRLM NUMB,RUNPPN
HRRM NUMB,RUNPPN
MOVEM WORD,RUNDEV
ATOM: SETZB NUMB,WORD
PUSH P,[POINT 6,WORD]
ATOM.2: PUSHJ P,GETCHR
CAIG SEPAR,'Z'
CAIGE SEPAR,'A'
CAIG SEPAR,'9'
CAIGE SEPAR,'0'
JRST ATOM.4
LSH NUMB,3
TRO NUMB,-'0'(SEPAR)
TRNN WORD,77
IDPB SEPAR,(P)
JRST ATOM.2
ATOM.4: POP P,(P)
.POPJ: POPJ P,
decnum: movei numb,0 ;Start with zero.
decn.2: pushj p,getchr ;Get next char.
cail separ,'0' ;In range?
caile separ,'9'
popj p, ; No, return now.
imuli numb,^D10 ;Shift...
addi numb,-'0'(separ);Add...
jrst decn.2 ;Loop...
GETCHR: CAMLE POS,PRSLEN ;More to take?
JRST[ SETO SEPAR, ; No, return -1.
POPJ P,]
ILDB SEPAR,N ;Yes, get next char.
ADDI POS,1
CAIL SEPAR,141
SUBI SEPAR,40
SUBI SEPAR,40
POPJ P,
;get next sixbit word
;skip return if succesful,
; with sixbit value in ac 'word' and break char in ac 'separ'
;nonskip return if failure, with error code in 'err'
nxtwrd: PUSH p,t7 ; save an ac
SETZ word, ; clear result
MOVEI t7,6 ; max 6 chars in a sixbit word
nxtwr1: CALL nxtsix ; get next char
JRST[ POP p,t7 ; unsave an ac
POPJ P,] ; error, illegal char
JUMPL separ,.nwret ; end of string
SKIPN separ ; null char?
JRST nwillc ; yes, just return
CAIGE separ,'0' ; legal char?
JRST nwillc ; no
CAIG separ,'9' ; try again
JRST nxtwr2 ; yes, definitely legal
CAIL separ,'A' ; last chance
CAILE separ,'Z'
nwillc: JRST[ SKIPN cvseen ; have we seen a CTRL-V?
JRST .nwret ; sorry, illegal char
SETZM cvseen ; yes, clear the CTRL-V flag
JRST nxtwr2 ; and pretend it's a legal char
]
nxtwr2: JUMPE t7,nxtwr1 ; t7 = 0 means word is full -- don't store...
LSH word,6 ; shift left SIX BITs
IOR word,separ ; append next char
SOJA t7,nxtwr1 ; get next char, if room for more
.nwret: IMULI t7,6
LSH word,(t7) ; left justify
POP p,t7 ; restore an ac
AOS (p) ; bump return pc
POPJ P,
;read an octal number
;skip return if succesful,
; with octal value in ac 'word' and break char in ac 'separ'
;nonskip return if failure, with error code in 'err'
nxtoct: PUSH p,t7 ; save an ac
SETZ word, ; clear result
MOVEI t7,6 ; max six digits in an octal halfword
nxtoc1: CALL nxtsix ; get next char
JRST[ POP p,t7 ; error, illegal char (error code -2)
POPJ P,]
SKIPN separ ; null char?
JRST .noret ; yes, just return
CAIL separ,'0' ; legal digit?
CAILE separ,'7'
JRST .noret ; no
JUMPE t7,[ ; yes, but halfword is full
MOVEI err,errtlf
POP p,t7
POPJ P,]
LSH word,3 ; shift left one octal digit
SUBI separ,'0' ; convert to octal
IOR word,separ ; append next digit
SOJA t7,nxtoc1
.noret: POP p,t7 ; restore an ac
AOS (p) ; bump return pc
POPJ P,
;------------------------------------------------------------------------------
; Routines to handle "List Files". Currently just dummies.
;
; function LsFOpen(s: string; l: integer): boolean;
; function LsFMore: boolean;
; function LsFChar: char;
; function LsFClose: boolean;
LSFOPE::movei 1,[[ASCIZ "LSF? List Files not yet implemented"]]
movem 1,errtab
setzm lsterr
movni 1,2
movem 1,1(p)
popj p,
LSFMORE::
LSFCHAR::
LSFCLOSE::
movei 2,[ASCIZ "DSKIO: LSFxxx routine called."]
pushj p,bug##
;=============================================================================
;FUNCTION dskopen(n: STRING; a: CHAR): INTEGER;
;
;(* Opens the file "n" in access "a". Returns 0 if success,
; otherwise -1 if file wasn't found, and -2 on all other errors *)
;parameters
n==2
a==3
dskope::HRLI n,strsize ;Load default string length.
skipe prsarg ;Special case?
move n,prsarg ; Yes, use another argument.
setzm prsarg ;... but only once.
SKIPE ds.opn ; check if we already have an open file
bugerr <DSKOPEN: File is already open>
cain a,"R" ;Map new access codes to old.
movei a,1
cain a,"W"
movei a,2
cail a,1 ;Range check the new access code.
caile a,2
bugerr <DSKOPEN: Illegal access code>
DMOVE t0,[
EXP .IOASC ; use ascii mode
SIXBIT 'DSK'] ; default device
DMOVEM t0,dsopbk+.OPMOD
MOVEI t1,dslkln ; length of LOOKUP-block
MOVEM t1,dslkbk+.RBCNT ; it might be clobberd
MOVEI t0,dslkpt ;Pointer to path.
SETZ t1, ;Empty file name.
DMOVEM t0,dslkbk+.RBPPN
MOVE t1,[
dslkbk+.RBEXT,,dslkbk+.RBPRV]; set up to clear lookup block
SETZM dslkbk+.RBEXT ; clear first word
BLT t1,dslkbk+.RBDEV ; clear the block
PUSH p,3 ; save ac3
MOVEI 3,dslkbk ; prepare to parse for lookup-block
CALL filprs ; parse the filename
POP p,3 ; unsave ac3
CAIE t0,errnoe ; check if no error
JRST fatal
SKIPE tcrdev ; tmpcore?
JRST @[
tcropn ; yes, go read in from TMP:
opnret ; yes, but nothing special when writing
]-1(A)
MOVEI t0,ERDNA% ; assume device not available
OPEN dsk,dsopbk ; open device
JRST fatal
MOVE t1,dsopbk+.OPDEV
DEVTYP t1, ; ask monitor what kind of device
bugerr <DSKOPEN: DEVTYP failed>
JRST @[
opread ; open for read
opwrit ; open for write
]-1(a)
tcropn: HLLZ t4,dslkbk+.RBNAM ; no, read from TMP:
MOVE t5,[IOWD dsksiz/5,dsbuf1+3]
MOVE t3,[.TCRRF,,t4]
TMPCOR t3,
JRST[ MOVEI t0,ERFNF% ; wasn't there
JRST warn]
MOVEM t3,tcrsiz ; save number of read words
JRST opnret
; come here if open for read
opread:
TXNN t1,DV.IN ; can device can do input?
JRST fatal
MOVX t0,.INFIN ; infinitely large
MOVEM t0,blknum ; file assumed
SKIPE notdir ; is it a directory device?
JRST opre10 ; no, don't do LOOKUP
LOOKUP dsk,dslkbk
JRST[ HRRZ t0,dslkbk+.RBEXT; failed, return with error code
SKIPE t0 ; fatal error?
JRST fatal ; yes
JRST warn] ; no, just warning
MOVE t0,dslkbk+.RBSIZ ; get size in words
IDIVI t0,dsksiz/5 ; how many blocks?
SKIPE t1 ; exact?
ADDI t0,1 ; no, but we still want the last block
MOVEM t0,blknum ; save it
MOVEI t1,dsk ; disk channel
MOVEM t1,dslkpt+.PTFCN ; to path-block
MOVE t1,[.PTMAX,,dslkpt]
PATH. t1, ; get real path to the file
bugerr <Can't get real path to file> ; should never happen
PUSHJ P,FFIXUP ;[JE]
opre10: MOVEI t1,dsbfih ; use buffers for input
CALL bufbld ; build buffers
JRST opnret
; Routine to get file name and extension from Tops-10. (7.02)
FFIXUP: MOVE T1,[
XWD 2,[
XWD DSK,.FOFIL
XWD ^D11,EXPFIL]]
FILOP. T1, ;Try get Name and Ext. from Topsy.
POPJ P, ; Nope, just ignore this.
MOVE T1,EXPFIL+.FOFFN;Get file name, and store in LOOKUP block.
MOVEM T1,DSLKBK+.RBNAM
MOVE T1,EXPFIL+.FOFEX;Get extension, and store in LOOKUP block.
HLLM T1,DSLKBK+.RBEXT
POPJ P, ;Return, with LOOKUP/ENTER block updated.
; come here if open for write
opwrit:
TXNN t1,DV.OUT ; can device do output?
JRST fatal
movei t0,errnw8 ;Assume /8 set.
skipe flag8 ;Is it?
jrst fatal ; Yes, then we cannot write.
MOVEI t1,<.PTSLJ>B29+<.PTSCN>B35
MOVEM t1,dslkpt+.PTSWT ; don't use fishy switches
LDB t1,[POINT ^D9,dslkbk+.RBPRV,^D8] ; save original prot.
MOVEM t1,orgpro
SKIPN notdir ; is it a directory device?
LOOKUP dsk,dslkbk ; see if it is an existing file
JRST nfound ; no open a new one
MOVEI t1,dslkpt
MOVEM t1,dslkbk+.RBPPN ; set pointer to path block
MOVEI t1,dsk
MOVEM t1,dslkpt+.PTFCN ; channel
MOVE t1,[11,,dslkpt] ; length,,arg
PATH. t1, ; find out path to this file
bugerr <Can't get path to file>
PUSHJ P,FFIXUP ;[JE]
SETOM xxbak ; yes, indicate that we're using backup
SKIPE orgpro ; do we have an original prot already?
JRST opwr05 ; yes
LDB t1,[POINT ^D9,dslkbk+.RBPRV,^D8] ; save original prot.
MOVEM t1,orgpro
opwr05: HLLZ t1,dslkbk+.RBEXT ; save original extension
MOVEM t1,orgext
MOVE t1,dslkbk+.RBNAM ; save original filename
MOVEM t1,orgnam
MOVE t1,tmppro ; use temporary protection
DPB t1,[POINT ^D9,dslkbk+.RBPRV,^D8]
MOVE t1,tmpnam ; use the temporary name
MOVEM t1,dslkbk+.RBNAM
MOVE t1,tmpext ; use temporary fileextension
HLLM t1,dslkbk+.RBEXT
MOVEI t0,ERDNA% ; assume device not available
OPEN dsk,dsopbk ; open device again
JRST fatal
nfound: HLLZS dslkbk+.RBEXT ; clear creation-date (high order bits)
SETZ t1,
DPB t1,[POINT ^D23,dslkbk+.RBPRV,^D35] ; and low bits
MOVE t1,[dslkbk+.RBSIZ,,dslkbk+.RBVER]
push p,dslkbk+.rbspl ;*****
push p,dslkbk+.rbver ;***
SETZM dslkbk+.RBSIZ
BLT t1,dslkbk+.RBDEV ; clear rest of LOOKUP block
pop p,dslkbk+.rbver ;***
pop p,dslkbk+.rbspl ;*****
ENTER dsk,dslkbk ; create a file
JRST[ HRRZ t0,dslkbk+.RBEXT ; error
JRST fatal]
SKIPE notdir ; is it a directory device?
JRST opwr10 ; no, don't try to get path
MOVEI t1,dsk ; disk channel
MOVEM t1,dslkpt+.PTFCN ; to path-block
MOVE t1,[.PTMAX,,dslkpt]
PATH. t1, ; get real path to the file
bugerr <Can't get real path to the file>
PUSHJ P,FFIXUP ;[JE]
opwr10: MOVEI t1,dsbfoh ; use buffers for output
CALL bufbld ; build buffers
OUT dsk, ; try a dummy OUT
SKIPA
bugerr <DSKOPEN: Dummy OUT failed>
opnret: MOVE t1,a
MOVEM t1,ds.opn ; the file is now open
SETZM 1(P)
POPJ P, ; all's well, return with 0
;build buffers, arg is pointer to buffer header control block in t1
bufbld:
PUSH p,t0
MOVX t0,<BF.VBR+dsbuf1+.BFHDR>; pointer to current buffer
MOVEM t0,.BFADR(t1) ; put it in buffer-header
MOVE t0,[POINT 7,0,35]
MOVEM t0,.BFPTR(t1) ; set up byte-pointer
SETZM .BFCTR(t1) ; clear byte-counter
HRLZI t0,dsksiz/5+1 ; buffer size + 1
HRRI t0,dsbuf2+.BFHDR
MOVEM t0,dsbuf1+.BFHDR ; set up first buffer
HRRI t0,dsbuf3+.BFHDR
MOVEM t0,dsbuf2+.BFHDR ; set up second buffer
HRRI t0,dsbuf4+.BFHDR
MOVEM t0,dsbuf3+.BFHDR ; set up third buffer
HRRI t0,dsbuf5+.BFHDR
MOVEM t0,dsbuf4+.BFHDR ; set up fourth buffer
HRRI t0,dsbuf6+.BFHDR
MOVEM t0,dsbuf5+.BFHDR ; set up fifth buffer
HRRI t0,dsbuf1+.BFHDR
MOVEM t0,dsbuf6+.BFHDR ; set up sixth buffer
POP p,t0
POPJ P,
;=============================================================================
;PROCEDURE truename (VAR namstr: string; fields: char);
;
;(* Gives the name of the opened file. *)
;parameters
namstr==2
fields==3
;locals
sixwrd==6
number==5
char==5
x1==7
x2==10
;flags to decide what fields to return
devp==1B35 ; 1
namep==1B34 ; 2
typep==1B33 ; 4
dirp==1B32 ; 8
attrp==1B31 ; 16
nodep==1B30 ; 32
truena::cain fields,"B" ;Map from new calling standard...
movei fields,<namep>
cain fields,"D"
movei fields,<nodep+devp+namep+typep+dirp>
cain fields,"F"
movei fields,<devp+namep+typep+dirp+attrp>
push p,namstr ;Save argument, for retry.
pushj p,.truen ;First try...
jumpge t1,tnret ;All OK, return.
trz fields,<nodep+attrp>
move namstr,(p)
pushj p,.truen ;second try...
jumpge t1,tnret ;Did it without protection, good.
trz fields,dirp
move namstr,(p)
pushj p,.truen ;Last try...
tnret: pop p,(p) ;restore stack.
popj p, ;return.
.truen: CALL blanks ; blank the string
HRLI namstr,(POINT 7,0) ; make a bytepointer
MOVEI t1,strsiz ; length of string
txnn fields,nodep ;Node name wanted?
jrst no.nod ; Nope, skip a bit.
movei x1,2 ;Set up argument list length.
movei x2,.gtloc
gettab x2, ;Get number of local node.
jrst no.nod ; Oops...
movx sixwrd,<.ndrnn,,x1>
node. sixwrd, ;Convert to node name.
jrst no.nod ; Oops...
call trusix ;Store in string.
movei char,":" ;Store double colon.
call putnam
call putnam
no.nod: SKIPN sixwrd,dslkbk+.RBDEV ; if nothing there
SKIPA sixwrd,dsopbk+1 ; then try here
TRZ sixwrd,007777 ; only first 4 chars, thank you
MOVEM sixwrd,dsopbk+1 ; save device name
TXNN fields,devp
JRST no.dev
CALL trusix ; output to the namestring
MOVEI char,":" ; colon finishes
CALL putnam
no.dev: MOVE t7,dsopbk+1 ; get device name again
HLRZ t6,t7 ; we need it once more
DEVTYP t7, ; get charcteristics
bugerr <TRUNAME: DEVTYP failed>
TXNE t7,TY.MAN+TY.SPL ; directory device or spooled device?
JRST trufil ; yes, print at least filename
CAIE t6,'TMP' ; no, is it TMP: ?
POPJ P, ; no, don't do anything more
SETO t7, ; make sure we don't go past filename
trufil: TXNN fields,namep
JRST no.nam
MOVE sixwrd,dslkbk+.RBNAM ; filename
CALL trusix
no.nam: TXNE t7,TY.SPL ; spooled device?
POPJ P, ; yes, don't print any more junk
TXNN fields,typep
JRST no.typ
MOVEI char,"." ; separates from extension
CALL putnam
HLLZ sixwrd,dslkbk+.RBEXT ; get extension
CALL trusix ; print the extension
no.typ: TXNN fields,dirp
JRST no.dir
trudir: MOVEI char,"[" ; here comes directory
CALL putnam
SKIPE dslkbk+.RBPPN ; null pointer
JRST trudi1 ; no, proceed
MOVE t8,dsopbk+1
MOVEM t8,dslkpt+.PTFCN ; device
MOVE t7,[.PTMAX,,dslkpt]
PATH. t7, ; get default path
bugerr <TRUENAME: Can't get path of device>
trudi1: HLRZ number,dslkpt+.PTPPN ; get project
CALL truoct
MOVEI char,"," ; separate with comma
CALL putnam
HRRZ number,dslkpt+.PTPPN ; get programmer
CALL truoct
MOVEI t7,dslkpt+.PTSFD ; get first sfd
trudi2: SKIPN (t7) ; null sfd?
JRST trudi3 ; yes, end of directory
MOVEI char,"," ; separator
CALL putnam
MOVE sixwrd,(t7) ; get sfd-name
CALL trusix
AOJA t7,trudi2 ; get next sfd
trudi3: MOVEI char,"]" ; finishes the directory
CALL putnam
no.dir: TXNN fields,attrp
JRST no.att
trupro: MOVEI char,"<" ; start of protection field
CALL putnam
MOVEI t8,3 ; three digits in protection code
MOVE t7,[POINT 3,dslkbk+.RBPRV] ; pointer to protection code
trupr1: ILDB char,t7 ; get a digit
ADDI char,"0" ; convert to ascii
CALL putnam ; put it in string
SOJG t8,trupr1 ; get next digit
MOVEI char,">" ; end of protection field
CALL putnam
skipn flag8 ;[JE] Eight bit?
jrst no.att ;[JE] Nope, skip this.
movei char,"/" ;[JE] Yes, add "/" to string.
pushj p,putnam
move char,flag8 ;[JE] Add kind of eight-bit.
pushj p,putnam
no.att: popj p,
; put a sixbit word in the string.
; sixbit word in ac 'sixwrd'.
trusix: JUMPE sixwrd,[POPJ P,] ; null word
trusi1: SETZ char,
LSHC char,6 ; get a sixbit byte
ADDI char," " ; convert to ascii
CAIGE char,"0" ; legal char?
JRST trusi2 ; no
CAIG char,"9" ; try again
JRST trusi3 ; yes, definitely legal
CAIL char,"A" ; last chance
CAILE char,"Z"
trusi2: JRST[ HRLZ char,char ; save char in left half of ac
HRRI char,.CHCNV ; CTRL-V
CALL putnam ; put the ^V
HLRZ char,char ; get back the char
JRST trusi3] ; go put the char too
trusi3: CALL putnam ; put it in namestring
JUMPN sixwrd,trusi1 ; get next byte
POPJ P,
; put an octal number in the string.
; number in ac 'number'. number+1 is destroyed.
truoct: IDIVI number,^D8 ; get quotient and remainder
PUSH p,number+1 ; push remainder
SKIPE number ; IF quotient /= 0 THEN
CALL truoct ; trueoct (quotient)
POP p,char ; ELSE fall thru to put-routine
ADDI char,"0" ; but first convert to ascii
; put a character in the string..
; character in ac 'char'.
putnam: SUBI t1,1 ;[JE]Decrement char counter
SKIPL t1 ;[JE]Room left in string?
IDPB char,namstr ;[JE] No, deposit the byte
POPJ P,
;=============================================================================
;FUNCTION TrueMode: majors;
;(* Return our opinion of what major mode this buffer shall have, *)
;(* based on what extension we have. *)
TRUEMO::HLRZ T1,DSLKBK+.RBEXT ;Get extension from lookup/enter block
MOVEI T2,MODLEN ;Get length of mode table
TMOD.2: HRRZ T3,MODTAB(T2) ;Get next extension from table
CAIN T3,(T1) ;Is this it?
JRST TMOD.4 ; Yes, go return corresponding mode
SOJGE T2,TMOD.2 ;No, decrement counter, and maybe loop back
MOVEI T1,MD%FUN ;No table left, assume fundamental mode
MOVEM T1,1(P) ;Return value for pascal
POPJ P,
TMOD.4: HLRZ T1,MODTAB(T2) ;We found a match, get the mode from table
MOVEM T1,1(P) ;Return it for pascal
POPJ P, ;All done!
;*** NOTE *** These must agree with the type 'majors' in MAIN.PAS
MD%FUN==1
MD%TXT==2
MD%ALG==3
MD%MAC==4
MD%PAS==5
MD%LSP==6
MD%C== 7
MD%TEX==10
MD%ADA==11
MD%MOD==12
MD%PL1==13
MD%BLI==14
MODTAB: XWD MD%TXT,'DOC' ;Documentation files
XWD MD%TXT,'HLP' ;Help files
XWD MD%TXT,'MAN' ;Manuals
XWD MD%TXT,'MEM' ;Memos
XWD MD%TXT,'MSS' ;Scribe something
XWD MD%TXT,'PL ' ;Prolog (NIL says text mode is best...)
XWD MD%TXT,'RFC' ;Request For Comments...
XWD MD%TXT,'TXT' ;General text files
XWD MD%ALG,'ALG' ;Algol-60
XWD MD%ALG,'SAI' ;Sail
XWD MD%ALG,'SIM' ;Simula
XWD MD%MAC,'MAC' ;Macro-10
XWD MD%MAC,'MID' ;Midas
XWD MD%MAC,'P11' ;Macro-11
XWD MD%PAS,'PAS' ;Pascal
XWD MD%LSP,'LSP' ;Lisp
XWD MD%C, 'C ' ;C
XWD MD%C, 'H ' ;C 'include' files
XWD MD%TEX,'TEX' ;TeX sources
XWD MD%ADA,'ADA' ;Frog code.
XWD MD%BLI,'BLI' ;Bliss (yeach) code.
XWD MD%BLI,'B36' ; -""-
XWD MD%BLI,'R36' ; -""-
XWD MD%BLI,'REQ' ; -""-
MODLEN==.-MODTAB
;=============================================================================
;PROCEDURE TruePos(var pagenumber, linenumber, charnumber: bufpos);
;(* Give back information about where in the file to start. *)
TRUEPO::move 1,pg.val
movem 1,(2) ;Give page #.
move 1,ln.val
movem 1,(3) ;Give line #.
move 1,ch.val
movem 1,(4) ;Give char #.
popj p, ;Return.
;=============================================================================
;FUNCTION dskcd(d: string): integer;
;(* This implements the function "Connect to Directory". *)
dskcd:: SETZM dslkpt ;Clear first word of PATH. block.
MOVE 1,[dslkpt,,dslkpt+1]
BLT 1,dslkpt+.PTMAX ;Clear rest of block.
HRLI 2,strsize ;Load string size.
MOVEI 3,dslkbk ;Load stupid argument pointer.
CALL filprs ;Call parser to fill in data.
CAIE t0,errnoe ;Any error?
JRST fatal ; Yes, conplain.
HRROI 1,.PTFSD
MOVEM 1,dslkpt+.PTFCN ;Set up function code.
MOVE 1,[.PTMAX,,dslkpt]
MOVEI t0,errccd ;Assume error.
PATH. 1, ;Try change default path.
JRST fatal ; Bad, propagate error.
SETZM 1,1(p) ;Give good return.
POPJ p,
;=============================================================================
;FUNCTION dskrecognition(VAR f: string; VAR len: integer; ch: char): boolean;
;(* This is the file name recognition routine. It just returns FALSE *)
;(* in this implementation. *)
DSKREC::SETZM 1(P) ;Clear return value. (Means FALSE)
POPJ P, ;Return and show that this did not work.
;=============================================================================
;FUNCTION dskread(VAR x: ^DSKBLOCK): INTEGER;
;
;(* Reads data from the file into x.
; Returns number of read characters if success, -1 if EOF and
; -2 if other error. *)
;parameters
x==2
dskrea::SKIPN ds.opn ; check if file is open
bugerr <DSKREAD: File is not open>
SKIPE tcrdev ; tmpcore?
JRST tcrrea ; yes
IN dsk,
JRST dskr10
STATZ dsk,IO.EOF ; check for end-of-file
JRST[ SETOM 1(P) ; return -1 in case of EOF
POPJ P,]
STATZ dsk,IO.ERR ; hard error?
bugerr <DSKREAD: Hard error. Please reboot>
bugerr <DSKREAD: Strange error>
POPJ P,
dskr10: HRRZ t1,dsbfih+.BFADR ; address to current buffer
ADDI t1,2 ; get pointer to start of buffer
SETAM t1,(x) ; to where it should end up
MOVE t3,dsbfih+.BFCTR ; get number of read bytes
skipe flag8 ;[JE] Eight-bit bytes?
jrst dskr.8 ;[JE] Yes, have to convert block.
SOSLE blknum ; last block?
JRST .inret ; no, just return count
pushj p,getlwd ;[JE] Get last word in buffer.
TXNN t5,000000000377 ; [BD] Ends with <NUL> ?
SUBI t3,1 ; [BD] yes, decrement count
TXNN t5,000000077777 ; [BD] Ends with <NUL> <NUL> ?
SUBI t3,1 ; [BD] yes, decrement count
TXNN t5,000017777777 ; [BD] Ends with <NUL> <NUL> <NUL> ?
SUBI t3,1 ; [BD] yes, decrement count
TXNN t5,003777777777 ; [BD] Ends <NUL> <NUL> <NUL> <NUL> ?
SUBI t3,1 ; [BD] yes, decrement count
.inret: MOVEM t3,1(p) ; return count
POPJ P,
; Get last data word in buffer.
getlwd: move t2,dsbfih+.bfptr;Get byte pointer.
movei t4,-1(t3) ;Get number of 7-bit bytes, minus one.
idivi t4,5 ;Get number of words minus one.
add t2,t4 ;Increment byte pointer.
ibp t2 ;... to last word somewhere.
move t5,(t2) ;Fetch last word.
popj p, ;return.
dskr.8: move t1,t3 ;Get number of bytes.
imuli t1,4 ;Convert to 8-bit bytes.
idivi t1,5
sosle blknum ;Last block?
jrst dskr8b ; Nope, just convert buffer.
pushj p,getlwd ;Get last word in buffer.
txnn t5,000000007777 ;Check for one null.
subi t1,1
txnn t5,000003777777 ;Check for two nulls.
subi t1,1
txnn t5,001777777777 ;Check for three nulls.
subi t1,1
dskr8b: movem t1,1(p) ;Set return value.
jumple t1,.popj ;Save some work for empty buffers.
movei t6,[jrst (t3)] ;Default to no conversion.
move t2,flag8 ;What kind of eight-bit?
cain t2,"I" ;I*M specials?
movei t6,cvtibm ; Yes, load conversion routine.
cain t2,"A" ;ANSI eight bit?
movei t6,cvtansi ; Yes, load conversion routine.
move t7,dsbfih+.bfptr;Get seven-bit byte pointer.
move t8,t7 ;Copy it.
tlc t8,001700 ;Convert to eight-bit pointer.
dskr8c: ildb t2,t8 ;Get eight-bit byte.
jsp t3,(t6) ;Possibly convert it.
idpb t2,t7 ;Store seven-bit byte.
sojg t1,dskr8c ;Decrement and loop.
popj p,
; Routine to convert eight-bit char in T2 to suitable seven-bit character.
define convert(c8,c7),<
cain t2,100+c8
movei t2,c7
>;convert macro
cvtibm: caig t2,200 ;High bit set?
jrst (t3) ; No, save compares.
convert "A","~"
convert "B","`"
convert "D","{"
convert "F","}"
convert "N","["
convert "O","]"
convert "P","@"
convert "T","|"
convert "Y","\"
convert "Z","^"
jrst (t3) ;Return from JSP call.
cvtansi:jrst (t3) ;Just return for now.
tcrrea: skipe tcrflg ; have we read a block already?
jrst[ setom 1(p) ; yes, return EOF
popj p,]
move t3,tcrsiz ; get number of words read
subi t3,1 ; minus one
move t4,t3 ; compute number..
imuli t3,5 ; ..of bytes
movei t0,dsbuf1+3 ; get pointer to buffer
movem t0,(x) ; give to caller
hrli t0,(POINT 7,0) ; make a bytepointer to the buffer
add t4,t0 ; adjust to last word - 1
tcrr10: ildb t5,t4 ; get that byte
skipe t5 ; <NUL>?
aoja t3,tcrr10 ; no, get next
movem t3,1(p) ; give number of read bytes to caller
setom tcrflg ; indicate we've read from TMP:
popj p,
;=============================================================================
;FUNCTION dsknext: ^DSKBLOCK;
;
;(* Returns the address of the next available diskbuffer. *)
dsknex::HRRZ t1,dsbfoh+.BFADR ; address of buffer header
SKIPE tcrdev ; tmpcore?
MOVEI t1,dsbuf1+.BFHDR ; yes, use predefined buffer
ADDI t1,2 ; offset to get beginning of text
MOVEM t1,1(p)
POPJ p,
;=============================================================================
;FUNCTION dskwrite(count: INTEGER) INTEGER;
;
;(* Writes count bytes of data on the file from x.
; Returns 0 if success, -2 otherwise. *)
;parameters
count==2
dskwri::SKIPN ds.opn ; check if file is open
bugerr <DSKWRITE: File is not open>
CAILE count,dsksiz
bugerr <DSKWRITE: Too large diskblock>
MOVE t3,count ; get number of bytes to write
IDIVI t3,5
;[je] n'th try to get the correct byte pointer...
movei t5,dsbuf1+3
hrli t5,(point 7)
skipn tcrdev
move t5,dsbfoh+.bfptr
add t3,t5
dskw10: JUMPE t4,dskw20
IBP t3
SOJA t4,dskw10
dskw20: SETAM t3,dsbfoh+.BFPTR
CAIE count,dsksize ; check if disk block full (*JMR*)
CALL filnul
MOVNI t3,9(count) ; calculate number of full words(*JMR*)
IDIVI t3,5 ; in the buffer (*JMR*)
HRLZ t3,t3 ; make an AOBJN pointer out of (*JMR*)
HRR t3,dsbfoh+.BFADR ; it (*JMR*)
ADDI t3,1 ; (*JMR*)
MOVEI t4,1 ; bit to clear (*JMR*)
dskw30: AOBJP t3,dskw40 ; more words to clear bit in? (*JMR*)
ANDCAM t4,(t3) ; yes, clear least significant (*JMR*)
JRST dskw30 ; bit and loop (*JMR*)
dskw40: SKIPE tcrdev ; tmpcore?
JRST tcrwri ; yes
OUT dsk,
JRST[ SETZM 1(p) ; all's well
POPJ p,]
STATZ dsk,IO.ERR ; hard error?
bugerr <DSKWRITE: Hard error.Error code later>
bugerr <DSKWRITE: Strange error>
tcrwri: HLLZ t4,dslkbk+.RBNAM ; get filename
MOVN t5,count ; negative number of bytes to write
IDIVI t5,5 ; convert
JUMPE t6,tcrw10 ; into
SUBI t5,1 ; words
tcrw10: HRLZ t5,t5 ; make an
HRRI t5,dsbuf1+2 ; IOWD
MOVE t3,[.TCRWF,,t4]
TMPCOR t3, ; write the TMP: file
JRST[ MOVEI t0,ERNRM% ; too large possibly
JRST fatal]
SETZM 1(p) ; all's well
POPJ p,
filnul: SETZ t0, ; if not, nullpad last word (*JMR*)
TLNN t3,37B22 ; check if thru last word (*JMR*)
POPJ p, ; done, exit from small loop (*JMR*)
IDPB t0,t3 ; store a null in buffer ring (*JMR*)
JRST filnul ; and loop back for next byte (*JMR*)
;=============================================================================
;FUNCTION dskclose: INTEGER;
;
;(* Closes the open file. Returns 0 if succesful,
; -1 if file not found, -2 otherwise. *)
dskclo::SKIPN ds.opn ; check if file is open
bugerr <DSKCLOSE: File is not open>
SKIPE tcrdev ; tmpcore?
JRST dskcl1 ; yes
RELEAS dsk, ; release the channel
SKIPN xxbak ; do we have backup?
JRST dskcl1 ; no we're finished
MOVE t1,orgnam ; get original name
SETAM t1,dslkbk+.RBNAM
MOVE t1,bakext ; get backupextension
HLLM t1,dslkbk+.RBEXT
MOVEI t0,ERDNA% ; assume device not available
OPEN dsk,dsopbk ; open the device
JRST fatal ; sorry...
LOOKUP dsk,dslkbk ; do we have an old backup file?
JRST newbak ; no
SETZ t0, ; yes
RENAME dsk,t0 ; delete old backup file
JRST[ MOVEI t0,errbkd ; can't delete old backup
JRST fatal]
newbak: MOVE t1,orgnam ; get original name back
SETAM t1,dslkbk+.RBNAM
MOVE t1,orgext ; get original extension back
HLLM t1,dslkbk+.RBEXT
MOVEI t0,ERDNA% ; assume device not available
OPEN dsk,dsopbk ; try open a device
JRST fatal
LOOKUP dsk,dslkbk ; lookup the original file
JRST rentmp ; never mind, perhaps we don't have one
SETOM proflg
HRRZ t2,dslkbk+.RBEXT ; get creation date
HLL t2,bakext ; get backup extension
tobakr: MOVEM t2,dslkbk+.RBEXT
RENAME dsk,dslkbk ; rename original file
JRST[ MOVEI t0,errbkr
SKIPN proflg ; have we tried before?
JRST fatal ; yes, tell'm we're sorry
LDB t1,[POINT 3,dslkbk+.RBPRV,2]
MOVEI t0,errbkr
CAIE t1,2 ; is it protection code 2 ?
JRST fatal ; no we can't rename
MOVE t1,orgext
HLLM t1,dslkbk+.RBEXT
MOVEI t1,1
DPB t1,[POINT 3,dslkbk+.RBPRV,2]
MOVEI t0,errbkr
RENAME dsk,dslkbk ; try to change the protection
JRST fatal ; can't lower prot, sorry
MOVEI t1,2
MOVE t1,orgpro
ANDI t1,477 ; safety measure in case of FILE DAEMON
DPB t1,[POINT ^D9,dslkbk+.RBPRV,^D8]
SETZM proflg ; don't try this again
JRST tobakr ; go try rename to backup name again
]
rentmp: MOVE t1,tmpnam ; get name of tmp-file
SETAM t1,dslkbk+.RBNAM
MOVE t1,tmpext ; get extension of tmp-file
HLLM t1,dslkbk+.RBEXT
MOVEI t0,ERDNA% ; assume device not available
OPEN dsk,dsopbk ; try open a device
JRST fatal
LOOKUP dsk,dslkbk ; lookup the tmp-file
JRST[ HRRZ t0,dslkbk+.RBEXT ; error
SKIPN t0
JRST warn
JRST fatal]
MOVE t1,orgnam ; get name of original file
SETAM t1,dslkbk+.RBNAM
MOVE t1,orgext ; get extension of original file
HLLM t1,dslkbk+.RBEXT
MOVE t1,orgpro ; get original protection
DPB t1,[POINT ^D9,dslkbk+.RBPRV,^D8]
RENAME dsk,dslkbk ; rename tmp-file to original file
JRST[ HRRZ t0,dslkbk+.RBEXT; failed, return with error code
SKIPN t0
JRST warn
JRST fatal]
RELEAS dsk, ; don't need device any more
SETZM xxbak ; reset backup flag
dskcl1: SETZM ds.opn ; file isn't open any more
SETZM tcrflg
SETZM tcrdev
SETZM notdir
setzm 1(p)
popj p,
;=============================================================================
;PROCEDURE dskmessage (VAR errstr: STRING);
;
;(* Returns latest disk-error. *)
;parameters
errstr==2
dskmes::CALL blanks ; blank the string
MOVE t1,errtab ; get what table
ADD t1,lsterr ; add offset into table
MOVE t1,(t1) ; get address of errorstring
HRLI t1,(POINT 7,0) ; make a bytepointer
MOVEI t4,strsiz ; max length of a string
MOVE t6,[POINT 7,(errstr)] ; make byte pointer to dest.
dskme1: ILDB t5,t1 ; get next char
JUMPE t5,dskme2 ; break on <NUL>
IDPB t5,t6 ; put byte in dest.
SOJG t4,dskme1 ; get next char, if room for more
dskme2: MOVEI t1,otherr
CAME t1,errtab ; misc. error?
popj p, ; no, just return
MOVEI t1,errbkr-errmis
CAME t1,lsterr ; errbkr error-code?
popj p, ; no, return
MOVE t6,[POINT 7,jobpos/5(errstr),<jobpos-jobpos/5*5>*7-1]
MOVE t1,[pOiNT 6,tmpnam] ; pointer to jobnumber in SIXBIT
MOVEI t4,3 ; mAx 3 digits in jobnumber
dskm10: ILDB t5,t1 ; get next digit
ADDI t5," " ; convert to ascii
IDPB t5,t6 ; store it
SOJG t4,dskm10 ; get next digit
popj p,
; routine to set latest error, argument in ac0, which is preserved on exit
seterr:
PUSH p,t0
PUSH p,t1
PUSH p,t2
CAILE t0,1000 ; misc. error?
JRST[ SUBI t0,errmis ; subtract to get offset
MOVEI t1,otherr ; use misc. error table
MOVEI t2,othmax ; check
JRST setchk ; boundaries
]
CAILE t0,100 ; parsing error codes are > 100
JRST[ SUBI t0,errnoe ; subtract first error to get offset
MOVEI t1,prserr ; use parsing error table
MOVEI t2,prsmax ; check
JRST setchk ; boundaries
]
MOVEI t1,monerr ; use monitor error table
MOVEI t2,monmax
setchk: JUMPL t0,setch1 ; IF offset < 0 OR
CAMG t0,t2 ; offset > max allowed
JRST seter1 ; THEN
setch1: MOVEI t1,errset ; use special error-error
SETZ t0, ; FI
seter1: SETAM t1,errtab ; set what table to use
SETAM t0,lsterr ; set latest error
CLOSE dsk, ; close the file
SETZM tcrflg
SETZM tcrdev
SETZM notdir
SETZM ds.opn ; and remember it
SETZM xxbak ; clear backup-flag too
POP p,t2
POP p,t1
POP p,t0
popj p,
fatal: CALL seterr ; set latest error
movx t1,-2
movem t1,1(p)
popj p,
warn: CALL seterr ; set latest error
setom 1(p)
popj p,
;=============================================================================
;High segment data and literals
tmppro: EXP 100 ; temporary protection
tmpext: SIXBIT 'TMP' ; temporary extension
bakext: SIXBIT 'BAK' ; backup extension
;special error-error
errset: [ASCIZ "UNK? Unknown error in DSKIO"]
;error table, misc. errors
otherr:
errmis==1001
[ASCIZ "IOF? This is no error"]
errbkd==1002
[ASCIZ "IOF? Can't delete old backup file"]
errbkr==1003
[ASCIZ "IOF? Backup failed, saving as nnnAMI.TMP"]
; 123456789012345678901234567890^
jobpos==^D31-1
errccd==1004
[ASCIZ "CCD? Can't change directory"]
othmax==.-otherr-1
;error table, parsing errors.
prserr:
;40 chars: " "
[ASCIZ "FSE? No error, success"] ;errnoe==101
[ASCIZ "FSE? Illegal character in filespec."] ;erricf==102
[ASCIZ "FSE? Too long field in filespecification"] ;errtlf==103
[ASCIZ "FSE? Duplicate filespec"] ;errdfn==104
[ASCIZ "FSE? Duplicate extension"] ;errdex==105
[ASCIZ "FSE? Double directory"] ;errddr==106
[ASCIZ "FSE? Colon, but no device"] ;errcnd==107
[ASCIZ "FSE? Duplicate device"] ;errddv==110
[ASCIZ "FSE? Illegal separator in directory"] ;errils==111
[ASCIZ "FSE? Too many sfds"] ;errtms==112
[ASCIZ "FSE? Null sfd"] ;errnls==113
[ASCIZ "FSE? Illegal format for directory"] ;errilf==114
[ASCIZ "FSE? Illegal protection code"] ;errilp==115
[ASCIZ "FSE? Duplicate protection"] ;errdpr==116
[ASCIZ "FOO? Cannot write 8-bit files"] ;errnw8==117
prsmax==.-prserr-1
;LOOKUP/ENTER/RENAME/GETSEG/RUN ERROR CODES "
monerr:
[ASCIZ "IOE? File not found"] ;ERFNF%==0
[ASCIZ "IOE? Incorrect ppn"] ;ERIPP%==1
[ASCIZ "IOE? Protection failure"] ;ERPRT%==2
[ASCIZ "IOE? File being modified"] ;ERFBM%==3
[ASCIZ "IOE? Already existing file name"] ;ERAEF%==4
[ASCIZ "IOE? Illegal sequence of uuos"] ;ERISU%==5
[ASCIZ "IOE? Transmission error"] ;ERTRN%==6
[ASCIZ "IOE? Not a save file"] ;ERNSF%==7
[ASCIZ "IOE? Not enough core"] ;ERNEC%==10
[ASCIZ "IOE? Device not available"] ;ERDNA%==11
[ASCIZ "IOE? No such device"] ;ERNSD%==12
[ASCIZ "IOE? Ill. mon. call for getseg and filop"] ;ERILU%==13
[ASCIZ "IOE? No room"] ;ERNRM%==14
[ASCIZ "IOE? Write-locked"] ;ERWLK%==15
[ASCIZ "IOE? Not enough table space"] ;ERNET%==16
[ASCIZ "IOE? Partial allocation"] ;ERPOA%==17
[ASCIZ "IOE? Block not free"] ;ERBNF%==20
[ASCIZ "IOE? Can't supersede a directory"] ;ERCSD%==21
[ASCIZ "IOE? Can't delete non-empty directory"] ;ERDNE%==22
[ASCIZ "IOE? Sfd not found"] ;ERSNF%==23
[ASCIZ "IOE? Search list empty"] ;ERSLE%==24
[ASCIZ "IOE? Sfd nest level too deep"] ;ERLVL%==25
[ASCIZ "IOE? No-create for all s/l"] ;ERNCE%==26
[ASCIZ "IOE? Segment not on swap space"] ;ERSNS%==27
[ASCIZ "IOE? Can't update file"] ;ERFCU%==30
[ASCIZ "IOE? Low seg overlaps hi seg (getseg)"] ;ERLOH%==31
[ASCIZ "IOE? Not logged in (run)"] ;ERNLI%==32
[ASCIZ "IOE? File has outstanding locks set"] ;ERENQ%==33
[ASCIZ "IOE? Bad .EXE file directory (getseg,run"] ;ERBED%==34
[ASCIZ "IOE? Bad ext. for .EXE file(getseg,run)"] ;ERBEE%==35
[ASCIZ "IOE? .EXE directory too big(getseg,run)"] ;ERDTB%==36
[ASCIZ "IOE? TSK - exceeded network capacity"] ;ERENC%==37
[ASCIZ "IOE? TSK - task not available"] ;ERTNA%==40
[ASCIZ "IOE? TSK - undefined network node"] ;ERUNN%==41
[ASCIZ "IOE? Rename - sfd is in use"] ;ERSIU%==42
[ASCIZ "IOE? Delete - file has an ndr lock"] ;ERNDR%==43
[ASCIZ "IOE? Job count high (A.T. read cnt ovrfl"] ;ERJCH%==44
[ASCIZ "IOE? Cannot rename sfd to a lower level"] ;ERSSL%==45
monmax==.-monerr-1
LIT
;=============================================================================
;Lowsegment storage
RELOC
; OPEN block
dsopbk: EXP 0 ; I/O status and flags
EXP 0 ; Sixbit device name or UDX
dsbfoh,,dsbfih ; Buffer ring header pointers
dsopln==.-dsopbk
; LOOKUP/ENTER block
dslkbk: EXP dslkln ; .RBCNT, Number of args following
XWD 0,dslkpt ; .RBPPN, Pointer to path
BLOCK .RBDEV+1-.RBNAM
dslkln==.-dslkbk-1
; Job's PPN (*JMR*)
jobppn: BLOCK 1 ; Logged in PPN (*JMR*)
; PATH.-block
dslkpt: BLOCK .PTMAX+1
prslen: BLOCK 1 ;String length when parsing file names.
prsarg: block 1 ;Special input pointer for parser.
tcrsiz: BLOCK 1 ; place to save number of read words
tcrdev: BLOCK 1 ; flag for TMP:
tcrflg: BLOCK 1 ; flag for reading TMP:
notdir: BLOCK 1 ; flag for non-directory devices
ds.opn: EXP 0 ; file-is-open flag
; buffer ring headers
dsbfoh: BLOCK 3 ; output header
dsbfih: BLOCK 3 ; input header
; buffers
dsbuf1: BLOCK 3 ; first buffer
BLOCK dsksiz/5
dsbuf2: BLOCK 3 ; second buffer
BLOCK dsksiz/5
dsbuf3: BLOCK 3 ; third buffer
BLOCK dsksiz/5
dsbuf4: BLOCK 3 ; fourth buffer
BLOCK dsksiz/5
dsbuf5: BLOCK 3 ; fifth buffer
BLOCK dsksiz/5
dsbuf6: BLOCK 3 ; sixth buffer
BLOCK dsksiz/5
; data for backup
tmpnam: BLOCK 1 ; temporary filename
orgpro: BLOCK 1 ; original protection
orgnam: BLOCK 1 ; original file name
orgext: BLOCK 1 ; original extension
xxbak: BLOCK 1 ; backup flag
; storage for the error-handler
errtab: BLOCK 1 ; pointer to last error tabel
lsterr: BLOCK 1 ; offset into last error table
proflg: BLOCK 1 ; protection-code flag
cvseen: EXP 0 ; CTRL-V flag
save.n: BLOCK 1 ; place to save pointer to filename
savpos: BLOCk 1 ; place to save position in filename
blknum: BLOCK 1 ; number of blocks in file
TCRBUF: BLOCK 50 ;Buffer for TMP:EDS reading/writing.
RSCCNT: block 1 ;Count of argument chars rescanned.
RUNBLK:: ;[JE] Argument for /RUN:file
RUNDEV::!EXP 0 ;Device.
RUNFIL::!EXP 0 ;File name.
RUNEXT::!EXP 0 ;Extension.
EXP 0 ;Some zero word.
RUNPPN::!EXP 0 ;PPN.
EXP 0 ;Another zero word.
EXPFIL: BLOCK ^D11 ;Expand file name here.
PG.VAL: BLOCK 1 ;Value of /Page:nn
LN.VAL: BLOCK 1 ;Value of /Line:nn
CH.VAL: BLOCK 1 ;Value of /Char:nn
FLAG8: BLOCK 1 ;Byte size of input file.
END
Reference in New Issue View Git Blame Copy Permalink