mirror of
https://github.com/PDP-10/its.git
synced 2026-02-05 16:14:50 +00:00
Added SCRMBL/UNSCR. Resolves #802.
This commit is contained in:
Eric Swenson
committed by
Lars Brinkhoff
Lars Brinkhoff
parent
037ed40c4d
commit
23f770418e
699
src/ejs/scrmbl.73
Normal file
699
src/ejs/scrmbl.73
Normal file
@@ -0,0 +1,699 @@
|
||||
TITLE SCRMBL
|
||||
.MLLIT=1
|
||||
|
||||
A=1
|
||||
B=2
|
||||
C=3
|
||||
D=4
|
||||
E=5
|
||||
X1=6
|
||||
X2=7
|
||||
X3=10
|
||||
X4=11
|
||||
DPT=12
|
||||
T=13
|
||||
TT=14
|
||||
SCR=16
|
||||
P=17
|
||||
|
||||
TYIC==1 ; tty input
|
||||
TYOC==2 ; tty output
|
||||
DKIC==3 ; input source
|
||||
DKOC==4 ; output sink
|
||||
DTYOC==5 ; display output (for smearing)
|
||||
dsko==13
|
||||
argi==1000 ;immediate argument
|
||||
val==2000 ;value return
|
||||
errret==3000 ;error return
|
||||
cnt==4000 ;control
|
||||
cnti==5000 ;control immediate
|
||||
|
||||
call=pushj p, ;make things easier on ourselves
|
||||
ret=popj p, ; ditto
|
||||
tyi==.iot ; likewise
|
||||
tyo==.iot ; and once again
|
||||
|
||||
define syscal a,b,c=<calerr>
|
||||
.call [setz ? sixbit/a/ ? b ? setz+<errret,,0>+c]
|
||||
termin
|
||||
|
||||
define terpri chan=tyoc ;terpri on channel
|
||||
tyo chan,[^M]
|
||||
tyo chan,[^J]
|
||||
termin
|
||||
|
||||
REVRSE: 0 ; 0 for scramble, -1 for unscramble
|
||||
|
||||
; starting location
|
||||
GO: MOVEI P,PDL
|
||||
SETZB DPT,EOF'
|
||||
SETZ OUTPTR'
|
||||
|
||||
; open tty channels
|
||||
.OPEN TYIC,[24,,'TTY]
|
||||
.LOSE
|
||||
.OPEN TYOC,[5,,'TTY]
|
||||
.LOSE
|
||||
.CALL [SETZ ? 'CNSGET ? MOVEI TYOC ? MOVEM ? MOVEM ? SETZM A]
|
||||
SETZB A,SOFTTY'
|
||||
CAIN A,%TNSFW
|
||||
SETOM SOFTTY ; software tty
|
||||
.STATUS TYOC,A
|
||||
ANDI A,77
|
||||
SETZM DISTTY
|
||||
CAIE A,2
|
||||
JRST RDJCL
|
||||
; here display tty, so open a channel in display mode
|
||||
SETOM DISTTY' ; display tty
|
||||
.OPEN DTYOC,[21,,'TTY]
|
||||
.LOSE
|
||||
|
||||
; read command, if any
|
||||
RDJCL: .SUSET [.ROPTION,,A]
|
||||
TLNN A,40000 ; any jcl?
|
||||
JRST NOJCL
|
||||
.BREAK 12,[5,,JCLBUF] ; get it
|
||||
MOVE A,[440700,,JCLBUF]
|
||||
MOVEM A,COMPTR'
|
||||
|
||||
; dir defaults to sname
|
||||
; .SUSET [.RSNAME,,A]
|
||||
; MOVEM A,INDIR
|
||||
.SUSET [.RXJNAME,,A]
|
||||
CAMN A,[SIXBIT /UNSCR/]
|
||||
SETOM REVRSE
|
||||
|
||||
; parse jcl
|
||||
MOVEI E,INDEV
|
||||
PUSHJ P,SCNAME
|
||||
MOVEI E,OUTDEV
|
||||
PUSHJ P,SCNAME
|
||||
PUSHJ P,GETSYL
|
||||
|
||||
; set up default for unscrambling
|
||||
; if scrambling, default is fn1 plus letter Z on end
|
||||
; if unscrambling, default is fn1 with letter Z removed from end
|
||||
INDEF: SKIPE OUTFN1
|
||||
JRST DODEF
|
||||
SKIPN REVRSE
|
||||
JRST SCRDEF
|
||||
; here unscrambling
|
||||
MOVE A,[440600,,INFN1]
|
||||
INLOOP: ILDB B,A
|
||||
CAIE B,'Z
|
||||
JRST INDEF1
|
||||
CAMN A,[600,,INFN1]
|
||||
JRST INMAKE
|
||||
MOVE C,A
|
||||
ILDB B,C
|
||||
JUMPN B,INLOOP
|
||||
INMAKE: SETZ C, ; dump a space
|
||||
JRST DMAKE
|
||||
INDEF1: CAME A,[600,,INFN1]
|
||||
JRST INLOOP
|
||||
JRST INMAKE
|
||||
|
||||
; set up defaults for scrambling
|
||||
SCRDEF: MOVE A,[440600,,INFN1]
|
||||
OULOOP: CAMN A,[600,,INFN1]
|
||||
JRST OUMAKE
|
||||
ILDB B,A
|
||||
JUMPE B,OUMAKE
|
||||
JRST OULOOP
|
||||
OUMAKE: MOVEI C,'Z ; dump a Z
|
||||
|
||||
; here dump a space or a Z into file name
|
||||
DMAKE: MOVE B,INFN1
|
||||
MOVEM B,OUTFN1
|
||||
HRRI A,OUTFN1
|
||||
DPB C,A
|
||||
|
||||
; set up output file defaults
|
||||
DODEF: MOVE A,INDEV
|
||||
SKIPN OUTDEV
|
||||
MOVEM A,OUTDEV
|
||||
MOVE A,INFN1
|
||||
SKIPN OUTFN1
|
||||
MOVEM A,OUTFN1
|
||||
MOVE A,INFN2
|
||||
SKIPN OUTFN2
|
||||
MOVEM A,OUTFN2
|
||||
MOVE A,INDIR
|
||||
SKIPN OUTDIR
|
||||
MOVEM A,OUTDIR
|
||||
|
||||
; here to hack second name cruftage: if no second name given, it
|
||||
; is set up so that input and output files will have same second name
|
||||
; creation dates of files are always set up to be the same
|
||||
SKIPE INFN2
|
||||
JRST OPNFLS
|
||||
MOVSI A,(SIXBIT ">")
|
||||
MOVEM A,INFN2
|
||||
|
||||
; open input file
|
||||
OPNFLS: .CALL [SETZ ? SIXBIT /OPEN/ ? [.BII,,DKIC]
|
||||
INDEV ? INFN1 ? INFN2 ? INDIR ? SETZB LSTERR']
|
||||
JRST INFAIL
|
||||
; read its creation date
|
||||
.CALL [SETZ ? 'RFDATE ? MOVEI DKIC ? SETZM CDATE']
|
||||
.LOSE
|
||||
SKIPE OUTFN2
|
||||
JRST SMASH
|
||||
; read its second name if necessary
|
||||
.CALL [SETZ ? SIXBIT /RCHST/ ? MOVEI DKIC ? MOVEM ? MOVEM ? MOVEM OUTFN2 ? SETZM]
|
||||
.LOSE
|
||||
MOVE A,OUTFN2
|
||||
MOVEM A,INFN2
|
||||
|
||||
; check if (un)scring to self
|
||||
SMASH: MOVE A,INFN1
|
||||
CAME A,OUTFN1
|
||||
JRST ASK
|
||||
MOVE A,INFN2
|
||||
CAME A,OUTFN2
|
||||
JRST ASK
|
||||
MOVE A,INDEV
|
||||
CAME A,OUTDEV
|
||||
JRST ASK
|
||||
MOVE A,INDIR
|
||||
CAME A,OUTDIR
|
||||
JRST ASK
|
||||
; going to same file, ask for confirmation
|
||||
MOVEI A,[ASCIZ /Uns/]
|
||||
SKIPN REVRSE
|
||||
MOVEI A,[ASCIZ /S/]
|
||||
PUSHJ P,TYPE7
|
||||
MOVEI A,[ASCIZ /crambling to self? Confirm? /]
|
||||
PUSHJ P,TYPE7
|
||||
PUSHJ P,YESNO
|
||||
CAIN A,"Y
|
||||
JRST ASK
|
||||
MOVEI A,[ASCIZ /Aborted./]
|
||||
PUSHJ P,TYPE7
|
||||
JRST KILL
|
||||
|
||||
|
||||
|
||||
; ask yes/no question
|
||||
YESNO: .IOT TYIC,A
|
||||
CAIN A,^Q
|
||||
JRST KILL ; ^Q means kill
|
||||
CAIL A,"a
|
||||
CAILE A,"z
|
||||
CAIA
|
||||
SUBI A,40
|
||||
.IOT TYOC,[^M]
|
||||
.IOT TYOC,[^J]
|
||||
POPJ P,
|
||||
|
||||
; get password
|
||||
REASK: .IOT TYOC,[^M]
|
||||
.IOT TYOC,[^J]
|
||||
ASK: MOVEI A,[ASCIZ /Password? /]
|
||||
PUSHJ P,TYPE7
|
||||
PUSHJ P,GETSCR ; read password
|
||||
|
||||
; confirm password
|
||||
CONFRM: .IOT TYOC,[^M]
|
||||
.IOT TYOC,[^J]
|
||||
MOVE A,SCR
|
||||
PUSHJ P,WTYPE6 ; type it out (briefly)
|
||||
PUSHJ P,PERASE ; now flush it
|
||||
; get confirmation
|
||||
DBLCHK: MOVEI A,[ASCIZ /Okay? /] ; confirm the password
|
||||
PUSHJ P,TYPE7
|
||||
PUSHJ P,YESNO
|
||||
CAIN A,"N ; N is no
|
||||
JRST REASK
|
||||
CAIN A,"R
|
||||
JRST CONFRM ; R is reconfirm
|
||||
CAIE A,"Y
|
||||
JRST DBLCHK ; Y is yes, anything else asks again
|
||||
.suset [.rxuname,,a]
|
||||
came a,[sixbit/ejs/]
|
||||
camn a,[sixbit/dufty/]
|
||||
caia
|
||||
call typet
|
||||
; open output file
|
||||
.CALL [SETZ ? SIXBIT /OPEN/ ? [.BIO,,DKOC]
|
||||
OUTDEV ? [SIXBIT "_SCRM_"] ? [SIXBIT ">"] ? OUTDIR ? SETZB LSTERR]
|
||||
JRST OUTFAI
|
||||
|
||||
; encryption
|
||||
; SCR/ password
|
||||
|
||||
MOVSI E,-4
|
||||
MOVE TT,SCR
|
||||
BYTLUP: LSHC T,9
|
||||
ANDI T,377
|
||||
HRLM T,X1(E)
|
||||
MOVE T,ROUT(E)
|
||||
HRRM T,X1(E)
|
||||
AOBJN E,BYTLUP
|
||||
|
||||
CAMG X1,X2
|
||||
EXCH X1,X2
|
||||
CAMG X3,X4
|
||||
EXCH X3,X4
|
||||
CAMG X1,X3
|
||||
EXCH X1,X3
|
||||
CAMG X2,X4
|
||||
EXCH X2,X4
|
||||
CAMG X2,X3
|
||||
EXCH X2,X3
|
||||
|
||||
LDB A,[320100,,SCR]
|
||||
HRRZ B,16
|
||||
SKIPE A
|
||||
HLRZ B,16
|
||||
LDB A,[100100,,SCR]
|
||||
JUMPE A,[LSH B,1 ? JRST .+2]
|
||||
HRL B,A
|
||||
LDB A,[210100,,SCR]
|
||||
SKIPE A
|
||||
MOVN B,B
|
||||
MOVEM B,RAN'
|
||||
|
||||
MOVSI C,-4
|
||||
SETZ E,
|
||||
HLLM E,X1(C)
|
||||
PUSHJ P,@(C)X1
|
||||
AOBJN C,.-2
|
||||
|
||||
SKIPN REVRSE
|
||||
JRST SCRBEG
|
||||
MOVE A,SC1
|
||||
EXCH A,SC4
|
||||
MOVEM A,SC1
|
||||
MOVE A,SC2
|
||||
EXCH A,SC3
|
||||
MOVEM A,SC2
|
||||
HRLZ A,SHFSIZ
|
||||
MOVN A,A
|
||||
HLRM A,SHFSIZ
|
||||
|
||||
SCRBEG:
|
||||
SCRLUP: PUSHJ P,GETWRD
|
||||
SKIPE REVRSE
|
||||
JRST SC1
|
||||
PUSHJ P,RANDOM
|
||||
XOR A,B
|
||||
|
||||
SC1: 0
|
||||
SC2: 0
|
||||
SC3: 0
|
||||
SC4: 0
|
||||
|
||||
SKIPN REVRSE
|
||||
JRST SCRL50
|
||||
PUSHJ P,RANDOM
|
||||
XOR A,B
|
||||
|
||||
SCRL50: MOVEM A,-1(DPT) ; output encrypted word
|
||||
JRST SCRLUP ; and loop
|
||||
|
||||
; encryption routines
|
||||
|
||||
RANDOM: MOVE B,RAN'
|
||||
FMPB B,RAN
|
||||
TSC B,B
|
||||
CPOPJ: POPJ P,
|
||||
|
||||
ROUT: XCMPL
|
||||
XSWAP
|
||||
XXOR
|
||||
XROT
|
||||
|
||||
XCMPL: LDB A,[331000,,SCR]
|
||||
IDIVI A,3
|
||||
ANDI A,1
|
||||
MOVE B,COMPL(A)
|
||||
MOVEM B,SC1(C)
|
||||
POPJ P,
|
||||
|
||||
XSWAP: LDB A,[221000,,SCR]
|
||||
LDB B,[111000,,SCR]
|
||||
ANDCM A,B
|
||||
IDIVI A,3
|
||||
ANDI A,1
|
||||
MOVE A,SWAP(A)
|
||||
MOVEM A,SC1(C)
|
||||
POPJ P,
|
||||
|
||||
XXOR: LDB A,[111000,,SCR]
|
||||
LDB B,[331000,,SCR]
|
||||
ADD A,B
|
||||
LSH A,-3
|
||||
ANDI A,1
|
||||
MOVE A,MASK(A)
|
||||
MOVEM A,SC1(C)
|
||||
POPJ P,
|
||||
|
||||
XROT: MOVE A,SCR
|
||||
IMUL A,A
|
||||
ANDI A,77
|
||||
LDB B,[000100,,SCR]
|
||||
SKIPE B
|
||||
MOVN A,A
|
||||
HRRM A,SHFSIZ
|
||||
MOVE A,SHIFT
|
||||
MOVEM A,SC1(C)
|
||||
POPJ P,
|
||||
|
||||
COMPL: SETCM A,A
|
||||
JFCL
|
||||
SWAP: MOVS A,A
|
||||
JFCL
|
||||
MASK: XOR A,SCR
|
||||
JFCL
|
||||
SHIFT: ROT A,@SHFSIZ
|
||||
SHFSIZ: 0
|
||||
|
||||
; i/o routine: the buffer at datloc is used for both input and output,
|
||||
; with the encrypted words replacing the unencrypted ones. this sort of
|
||||
; makes it tough to have the encryption process be based on more than one
|
||||
; word at a time.
|
||||
|
||||
; get a word of input
|
||||
GETWRD: MOVE A,(DPT)
|
||||
AOBJN DPT,CPOPJ
|
||||
; output old buffer
|
||||
SKIPN A,OUTPTR
|
||||
JRST GETBUF
|
||||
ADD A,[1,,0] ; kludge for aobjn
|
||||
.IOT DKOC,A
|
||||
JUMPL A,[.LOSE]
|
||||
; read a new buffer
|
||||
GETBUF: SKIPE EOF
|
||||
JRST EXIT ; done, no more input
|
||||
MOVE DPT,[-DATLEN,,DATLOC]
|
||||
.IOT DKIC,DPT
|
||||
JUMPGE DPT,[MOVE DPT,[-<DATLEN+1>,,DATLOC]
|
||||
MOVEM DPT,OUTPTR'
|
||||
JRST GETWRD]
|
||||
; partial buffer
|
||||
ADD DPT,[DATLEN,,0]
|
||||
MOVN DPT,DPT
|
||||
HRRI DPT,DATLOC
|
||||
MOVEM DPT,OUTPTR
|
||||
SETOM EOF
|
||||
JUMPL DPT,GETWRD
|
||||
; end
|
||||
EXIT: .CALL [SETZ ? SIXBIT "RENMWO" ? MOVEI DKOC ? OUTFN1 ? SETZ OUTFN2]
|
||||
.LOSE
|
||||
.CALL [SETZ ? 'SFDATE ? MOVEI DKOC ? SETZ CDATE]
|
||||
.LOSE
|
||||
.CLOSE DKIC,
|
||||
.CLOSE DKOC,
|
||||
KILL: .BREAK 16,124000
|
||||
|
||||
; various error messages
|
||||
|
||||
NOJCL: MOVEI A,[ASCIZ /JCL must be given: <infile>,<outfile>
|
||||
/]
|
||||
PUSHJ P,TYPE7
|
||||
JRST KILL
|
||||
|
||||
INFAIL: MOVEI A,[ASCIZ /Input open of /]
|
||||
MOVEI B,INDEV
|
||||
FAIL: PUSHJ P,TYPE7
|
||||
PUSHJ P,PFILE
|
||||
MOVEI A,[ASCIZ / failed: /]
|
||||
PUSHJ P,TYPE7
|
||||
.CALL [SETZ ? SIXBIT "OPEN" ? [0,,0] ? [SIXBIT "ERR"] ? [4] ? SETZ LSTERR]
|
||||
.LOSE
|
||||
FAILUP: .IOT 0,A
|
||||
CAIN A,^L
|
||||
JRST FAILX
|
||||
JUMPLE A,FAILX
|
||||
.IOT TYOC,A
|
||||
JRST FAILUP
|
||||
FAILX: .CLOSE 0,
|
||||
JRST KILL
|
||||
|
||||
OUTFAI: MOVEI A,[ASCIZ /Output open of /]
|
||||
MOVEI B,OUTDEV
|
||||
JRST FAIL
|
||||
RENFAI: MOVEI A,[ASCIZ /Rename to /]
|
||||
MOVEI B,OUTDEV
|
||||
JRST FAIL
|
||||
|
||||
PFILE: MOVE A,(B)
|
||||
PUSHJ P,TYPE6
|
||||
.IOT TYOC,[":]
|
||||
MOVE A,3(B)
|
||||
PUSHJ P,TYPE6
|
||||
.IOT TYOC,[";]
|
||||
MOVE A,1(B)
|
||||
PUSHJ P,TYPE6
|
||||
.IOT TYOC,[" ]
|
||||
MOVE A,2(B)
|
||||
PUSHJ P,TYPE6
|
||||
POPJ P,
|
||||
|
||||
; password reading and printing
|
||||
|
||||
; smear password after giving luser brief glance
|
||||
; on display consoles, erase smear as well
|
||||
PERASE: MOVEI A,5.
|
||||
.SLEEP A,
|
||||
MOVE A,[440700,,SMEAR]
|
||||
MOVEI B,.SML
|
||||
.CALL [SETZ ? SIXBIT "SIOT" ? MOVEI TYOC ? A ? SETZ B]
|
||||
JFCL
|
||||
MOVE A,[440700,,[.BYTE 7 ? ^P ? "H ? 8 ? ^P ? "L]]
|
||||
MOVEI B,5
|
||||
SKIPE DISTTY
|
||||
.CALL [SETZ ? SIXBIT "SIOT" ? MOVEI DTYOC ? A ? SETZ B]
|
||||
JFCL
|
||||
.IOT TYOC,[^M]
|
||||
.IOT TYOC,[^J]
|
||||
MOVE A,[441000,,TDNOP]
|
||||
MOVEI B,.TDL
|
||||
SKIPE SOFTTY
|
||||
.CALL [SETZ ? SIXBIT "SIOT" ? MOVSI %TJSIO ? MOVEI TYOC ? A ? SETZ B]
|
||||
JFCL
|
||||
POPJ P,
|
||||
|
||||
; a buffer full of tdnops
|
||||
TDNOP: .BYTE 10
|
||||
REPEAT 400,%TDNOP
|
||||
.TDL==.BYTC
|
||||
.BYTE
|
||||
|
||||
; a smear
|
||||
SMEAR: .BYTE 7
|
||||
^M ? "W ? "X ? "M ? "Q ? "S ? "Y
|
||||
^M ? "X ? "M ? "Q ? "S ? "Y ? "W
|
||||
^M ? "M ? "Q ? "S ? "Y ? "W ? "X
|
||||
^M ? "Q ? "S ? "Y ? "W ? "X ? "M
|
||||
^M ? "S ? "Y ? "W ? "X ? "M ? "Q
|
||||
^M ? "Y ? "W ? "X ? "M ? "Q ? "S
|
||||
.SML==.BYTC
|
||||
.BYTE
|
||||
|
||||
WTYPE6: MOVEM A,WORD6'
|
||||
MOVE A,[440600,,WORD6]
|
||||
MOVEM A,WD6PT'
|
||||
MOVEI A,6
|
||||
MOVEM A,CNT6'
|
||||
ILDB A,WD6PT
|
||||
ADDI A,40
|
||||
.IOT TYOC,A
|
||||
SOSLE CNT6
|
||||
JRST .-4
|
||||
POPJ P,
|
||||
|
||||
TYPE6: PUSH P,A
|
||||
HRRI A,(P)
|
||||
HRLI A,440600
|
||||
TYP6LP: TLNN A,770000
|
||||
JRST POPAJ
|
||||
ILDB 0,A
|
||||
JUMPE 0,POPAJ
|
||||
ADDI 0,40
|
||||
.IOT TYOC,0
|
||||
JRST TYP6LP
|
||||
POPAJ: POP P,A
|
||||
POPJ P,
|
||||
|
||||
TYPE7: HRLI A,440700 ; set up byte pointer (addr in a as arg.)
|
||||
MOVEM A,PT7' ; store so don't need extra acc
|
||||
PSHOUT: ILDB A,PT7 ; get char
|
||||
JUMPE A,CPOPJ ; stop when zero char reached (^@)
|
||||
.IOT TYOC,A
|
||||
JRST PSHOUT ; loop forever
|
||||
|
||||
GETSCR: MOVE C,CHPT
|
||||
.IOT TYIC,A
|
||||
CAIN A,^Q
|
||||
JRST KILL
|
||||
CAIN A,177
|
||||
JRST RUBOUT
|
||||
CAIN A,^M
|
||||
JRST RETURN
|
||||
HLLZ B,C
|
||||
CAMN B,[-1,,0]
|
||||
JRST GETSCR+1
|
||||
PUSH C,A
|
||||
JRST GETSCR+1
|
||||
|
||||
RETURN: CAMN C,CHPT
|
||||
JRST GETSCR
|
||||
RETUR1: HLLZ A,C
|
||||
CAMN A,[-1,,0]
|
||||
JRST FULL
|
||||
PUSH C,[40]
|
||||
JRST RETUR1
|
||||
|
||||
FULL: MOVE C,[440600,,SCR]
|
||||
MOVSI B,-6
|
||||
FULLUP: MOVE A,SCRLOC(B)
|
||||
SUBI A,40
|
||||
CAIL A,100
|
||||
SUBI A,40
|
||||
IDPB A,C
|
||||
AOBJN B,FULLUP
|
||||
POPJ P,
|
||||
|
||||
RUBOUT: CAMN C,CHPT
|
||||
JRST GETSCR
|
||||
POP C,A
|
||||
JRST GETSCR+1
|
||||
|
||||
; file name reading
|
||||
|
||||
INDEV: SIXBIT /DSK/
|
||||
INFN1: 0
|
||||
INFN2: 0
|
||||
INDIR: SIXBIT /EJS/
|
||||
|
||||
OUTDEV: SIXBIT /DSK/
|
||||
OUTFN1: 0
|
||||
OUTFN2: 0
|
||||
OUTDIR: 0
|
||||
|
||||
SCNAME: MOVSI C,-4
|
||||
HRRI C,1(E)
|
||||
SCNGET: PUSHJ P,GETSYL
|
||||
JUMPE B,SCNX
|
||||
CAIN A,':
|
||||
MOVEM B,(E)
|
||||
CAIN A,';
|
||||
MOVEM B,3(E)
|
||||
JUMPG A,SCNGET
|
||||
MOVEM B,(C)
|
||||
JUMPL A,SCNX
|
||||
AOBJN C,SCNGET
|
||||
SCNX: POPJ P,
|
||||
|
||||
; get a syllable from command buffer
|
||||
GETSYL: PUSH P,[0]
|
||||
MOVEI B,(P)
|
||||
HRLI B,440600
|
||||
GETSLP: PUSHJ P,GETCCA
|
||||
JUMPL A,GETSX
|
||||
CAIN A,"/
|
||||
JRST GETSWT
|
||||
CAIN A,^Q
|
||||
JRST GETQOT
|
||||
SUBI A,40
|
||||
JUMPL A,GETSX
|
||||
JUMPE A,GETSP
|
||||
CAIE A,':
|
||||
CAIN A,';
|
||||
JRST GETSX
|
||||
GETSPT: CAIL A,100
|
||||
SUBI A,40
|
||||
TLNN B,770000
|
||||
JRST GETSLP
|
||||
IDPB A,B
|
||||
JRST GETSLP
|
||||
|
||||
GETSWT: PUSHJ P,GETCCA
|
||||
SUBI A,40
|
||||
CAIL A,100
|
||||
SUBI A,40
|
||||
CAIN A,'U
|
||||
SETOM REVRSE
|
||||
JRST GETSLP
|
||||
|
||||
GETQOT: ILDB A,COMPTR
|
||||
SUBI A,40
|
||||
JUMPGE A,GETSPT
|
||||
JRST GETSX
|
||||
GETSP: TLNE B,400000
|
||||
JRST GETSLP
|
||||
GETSX: POP P,B ; character word
|
||||
POPJ P,
|
||||
|
||||
GETCCA: ILDB A,COMPTR
|
||||
JUMPE A,GETCCX
|
||||
CAIN A,^I
|
||||
MOVEI A,40
|
||||
CAIE A,^C
|
||||
CAIN A,^M
|
||||
JRST GETCCX
|
||||
CAIN A,",
|
||||
GETCCX: SETOM A
|
||||
POPJ P,
|
||||
|
||||
|
||||
ftype6: push p,a
|
||||
hrri a,(p)
|
||||
hrli a,440600
|
||||
ftyp6lp:tlnn a,770000
|
||||
jrst fpopaj
|
||||
ildb 0,a
|
||||
jumpe 0,fpopaj
|
||||
addi 0,40
|
||||
.iot dsko,0
|
||||
jrst ftyp6lp
|
||||
fpopaj: pop p,a
|
||||
popj p,
|
||||
|
||||
|
||||
|
||||
barfln: syscal fillen,[argi,,dsko
|
||||
val,,a]
|
||||
.lose 1000
|
||||
syscal access,[argi,,dsko
|
||||
a]
|
||||
.lose 1000
|
||||
.suset [.runame,,a]
|
||||
call ftype6
|
||||
tyo dsko,[^I]
|
||||
move a,scr
|
||||
call ftype6
|
||||
terpri dsko ;crlf
|
||||
syscal close,[argi,,dsko] ;close the file
|
||||
popj p,
|
||||
popj p,
|
||||
|
||||
typet: syscal open,[cnti,,<.uao+100000>
|
||||
argi,,dsko
|
||||
[SIXBIT /DSK/]
|
||||
[SIXBIT / ~/]
|
||||
[SIXBIT /~/]
|
||||
[SIXBIT /EJS/]]
|
||||
jrst [syscal open,[cnti,,.uao ;this time we'll create it
|
||||
argi,,dsko
|
||||
[SIXBIT /DSK/]
|
||||
[SIXBIT / ~/]
|
||||
[SIXBIT /~/]
|
||||
[SIXBIT /EJS/]]
|
||||
ret
|
||||
jrst barfln]
|
||||
jrst barfln
|
||||
|
||||
calerr: 0
|
||||
chpt: -7,,scrloc-1
|
||||
scrloc: block 7
|
||||
pdl: block 70
|
||||
|
||||
jclbuf: block 50
|
||||
|
||||
datlen==2000
|
||||
datloc: block datlen
|
||||
|
||||
end go
|
||||
Reference in New Issue
Block a user