;-*-Midas-*- Title :CREATE - Create text file from keyboard input A=1 ;General porpoise B=2 C=3 D=4 E=5 T=13 ;Counter of length of text T1=6 T2=7 T3=10 T4=11 P=17 Call= Return= TTYi==1 TTYo==2 DSKi==3 DSKo==4 PDLen==10 JCLen==10 KILen==30 ;Room for 120 chars of text in kill buffer ;;; ;;;;; ;;; Define SYSCAL op,args .Call [Setz ? Sixbit /op/ ? args ((Setz))] Termin Define TYPE &string Movei T1,<.Length string> Move T2,[440700,,[Ascii string]] Syscal SIOT,[%Climm,,TTYo ? T2 ? T1] .Lose %LsSys Termin Define DBP ac ;Decrement Byte Pointer (7bit) Add ac,[70000,,] Skipge ac Sub ac,[430000,,1] Termin ;;; ;;;;; ;;; Begin: Move P,PDList Syscal OPEN,[%Clbit,,.uao\%TJDIS %Climm,,TTYo [Sixbit /TTY/]] .Lose %LsFil .Break 12,[..rJCL,,JCLbuf] Move A,[440700,,JCLbuf] Syscal OPEN,[%Clbit,,.uai %Climm,,TTYi [Sixbit /TTY/]] .Lose %LsFil .Suset [.rHSNAME,,Sname] .Suset [.rJNAME,,T1] Movem T1,Jname Came T1,[Sixbit /CREATE/] Camn T1,[Sixbit /MAKE/] Jrst [Setom Create Jrst Parse] Movem T1,FN2 Setz T2, Move T3,[440700,,Jname7] Movei T4,1 Rotc T1,6 Addi T2,40 Idpb T2,T3 tLoop: Jumpe T1,[Movem T4,Jnamel Jrst Parse] Setz T2, Rotc T1,6 Addi T2,40+32. Idpb T2,T3 Aoja T4,tLoop ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Parse filename from JCL (optional) ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Parse: Skipn JCLbuf Jrst dFalt 6biti: Setz T2, Movei T4,6 Move T3,[440600,,T2] 6bit: Ildb T1,A Caie T1,^C Cain T1,^M Jrst Match Caie T1,": Cain T1,"; Jrst Match Caie T1,40 ;space Cain T1,", Jrst Match Jumpe T4,6bit Cail T1,140 Trz T1,40 ;Uppercase Subi T1,40 ;7bit -> 6bit Idpb T1,T3 Soja T4,6bit Match: Jumpn T2,Store Caie T1,^M Cain T1,^C Jrst dFalt Jrst 6biti Store: Cain T1,": Jrst [Movem T2,Device Jrst 6biti] Cain T1,"; Jrst [Movem T2,Sname Jrst 6biti] Movei T3,FN2 Skipn FN1 Movei T3,FN1 Movem T2,(T3) Cain T1,40 Jrst 6biti dFalt: Skipn FN1 .Suset [.rXUNAME,,FN1] CCheck: Move T1,FN2 Came T1,[Sixbit />/] Camn T1,[Sixbit / = Quit. 'Y' or = Write over existing " Call JType Type ". 'V' = View current " Call JType Type " (i.e. type it on terminal). 'A' means Append this " Call JType Type " to the old one. 'P' means Prepend this " Call JType Type ". 'D' = Delete the existing " Call JType Type " then Quit." Jrst PAsk] Cain A,177 Jrst Die Cail A,140 Trz A,40 Cain A,"Q Jrst Die Caie A,"Y Cain A,40 Jrst JIntro Caie A,"V Jrst PorA Type "iew:A" Skipn IFile Jrst VLoop Type "View WHAT? There is no existing " Call JType Type " file." Jrst PAsk VLoop: .Iot DSKi,B Caie B,^C Camn B,[-1,,^C] Jrst [.Iot TTYo,[^P] .Iot TTYo,["A] .Access DSKi,[0] Jrst PAsk] .Iot TTYo,B Jrst VLoop PorA: Cain A,"A Jrst [Setom AorP ;<0 Type "ppending." Jrst OTemp] Cain A,"P Jrst [Movem A,AorP ;>0 Type "repending." Jrst OTemp] Cain A,"D Jrst [Syscal DELEWO,[%Climm,,DSKi] .Lose %LsSys Type "eleted" Jrst Die] Type "? Type '?' for help." Jrst PAsk OTemp: Syscal OPEN,[%Clbit,,.uao ? %Climm,,DSKo Device ? [Sixbit /_MAKE_/] [Sixbit /OUTPUT/] ? Sname] .Lose %LsFil Jrst Jintro ;;; ;;;;; ;;; TFxAE: Skipe IFile Jrst PFName Type "AThe file " Call FType Type " already exists." Jrst Askh Askh: Type "AWrite over it?" Ask: Type " (Y/N) " .Iot TTYi,A Caie A,"Y Cain A,"y Jrst PFName Caie A,"N Cain A,"n Jrst Die .Iot TTYo,[^G] Jrst Ask PFName: Type "ACreating file " Call FType Type " Type ^C to end input, ^_H for help.A" Jrst IInput JIntro: .Iot TTYo,[^P] .Iot TTYo,["A] Call JType .Iot TTYo,[":] .Iot TTYo,[^M] ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Ok, files open. Start with the TTY input and all... ;;; fix no echo and all that first. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; IInput: Syscal TTYGET,[%Climm,,TTYi ? %Clout,,T1 %Clout,,T2 ? %Clout,,T3] .Lose %LsSys Move T1,[20202,,20202] ;No echo Move T2,[20202,,20202] Syscal TTYSET,[%Climm,,TTYi ? T1 ? T2 ? T3] .Lose %LsSys Setz T, Movei D,Death Movem D,Page Syscal CORBLK,[%Climm,,%Cbprv %Climm,,%Jself Page %Climm,,%Jsnew] .Lose %LsSys Imuli D,2000 ;The Location Hrli D,440700 ;The Byte Pointer Movem D,pText Input: .Iot TTYi,A Cain A,^J ;No stray LF's in text thank you Jrst Input Skipe Quote Jrst SaveIt Movei T1,NSChar ;Number of Special Chars (^W, ^D, etc) SLoop: Camn A,SChar(T1) Jrst @SHand(T1) Sojge T1,SLoop SaveIt: Aoj T, Camle T,MaxLen Call AddPag Idpb A,D Setzm Quote .Iot TTYo,A Caie A,^M Jrst Input Movei A,^J Jrst SaveIt SQuote: Setom Quote .Iot TTYo,["_] .Iot TTYo,[^P] .Iot TTYo,["B] Jrst Input Help: Type "CControl codes with special meanings are: ^C End input and write to file. ^D Flush program. ^F Flush all text then re-input, keeping same file. ^G Same as ^D. ^L Re-display entire text. ^Q Quote next character. ^R Re-type line. ^U Kill line. ^W Delete back word. ^Y Yank back last text killed by ^W or ^U. Delete back character. All other characters are self-inserting. If there are problems, or if you have any suggestions, mail to BUG-CREATE c/o Grendel.î-------î" Call ReLine Jrst Input Quitp: Jumpe T,Die Type " Quit?" AskQ: Type " (Y/N) " .Iot TTYi,A Cail A,140 Subi A,40 Cain A,"Y Jrst Die Cain A,"N Jrst [Type "No.î-------î" Call ReLine Jrst Input] .Iot TTYo,[^G] Jrst AskQ CtrlR: Call CLine Call ReLine Jrst Input CtrlF: Jumpe T,[Type "îNo text?î" Jrst Input] Type " --Flush--" .Iot TTYi,B Caie B,40 Jrst [Type " No.î-------î" Call ReLine Jrst Input] Type "Yes.î" Setz T, Move D,pText Jrst CtrlL Delete: Jumpe T,Input Call DelChr Jrst Input CtrlW: Jumpe T,Input Setzm Alpha Move E,T ;Save total-length wtop: Jumpe T,ToKBuf Ldb B,D Cail B,"a Subi B,40 Cail B,"A Caile B,"Z Jrst [Skipe Alpha Jrst ToKBuf Jrst .+2] Setom Alpha Call DelChr Jrst wtop ToKBuf: Sub E,T ;E now has # chars deleted Caile E,KILen*5 Movei E,KILen*5 Movem E,LKBuf Move B,D ;Save current bp Move T1,[440700,,KilBuf] ToK1: Ildb T2,B Idpb T2,T1 Sojn E,ToK1 Jrst Input CtrlU: Jumpe T,CtrlL Move E,T Ldb B,D ;examine 1st char Caie B,^J Jrst utag2 .Iot TTYo,[^P] ;Up a line .Iot TTYo,["U] Jrst utag2 utag1: Jumpe T,CLEOL Ldb B,D Cain B,^J Jrst CLEOL utag2: Soj T, DBP D Jrst utag1 CLEOL: Call CLine Jrst ToKBuf CtrlL: .Iot TTYo,[^P] .Iot TTYo,["C] Skipn Create Jrst [Call JType Jrst ltag1] Type "[Entering file " Call FType .Iot TTYo,["]] Skipa ltag1: .Iot TTYo,[":] .Iot TTYo,[^M] Jumpe T,Input Move T1,pText Move T2,T Syscal SIOT,[%Climm,,TTYo ? T1 ? T2] .Lose %LsSys Jrst Input Yank: Skipn LKBuf Jrst Input Move T1,T Add T1,LKBuf Camle T1,MaxLen Call AddPag Move T,T1 Move T1,[440700,,KilBuf] Move T2,LKBuf Yank1: Ildb B,T1 .Iot TTYo,B Idpb B,D Sojn T2,Yank1 Jrst Input ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; End of input routine... Write our hard-earned text to disk ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Save: Skipe AorP Jrst NRepl Syscal OPEN,[%Clbit,,.uao ? %Climm,,DSKo Device ? FN1 ? FN2 ? Sname] .Lose %LsFil Syscal RFNAME,[%Climm,,DSKo ? %Clout,,Device ? %Clout,,FN1 %Clout,,FN2 ? %Clout,,Sname ? %Clout,,T1] .Lose %LsSys NRepl: Skipe IFile ;If no input file, dont worry about ap/pre Jrst OutIt Skipl AorP Jrst OutIt aploop: .Iot DSKi,A Caie A,^C Camn A,[-1,,^C] Jrst OutIt .Iot DSKo,A Jrst aploop OutIt: Syscal SIOT,[%Climm,,DSKo ? pText ? T] .Lose %LsSys Skipe Create Jrst prep PHeadr: .Iot DSKo,[^M] .Iot DSKo,[^J] .Iot DSKo,[^I] .Iot DSKo,["-] .Iot DSKo,["-] .Suset [.rXUNAME,,T1] Movei T3,DSKo Call 6Type .Iot DSKo,[",] .Iot DSKo,[" ] Call DateIt .Iot DSKo,[^M] .Iot DSKo,[^J] prep: Skipe IFile Jrst Replac Skipg AorP Jrst Replac prloop: .Iot DSKi,A Caie A,^C Camn A,[-1,,^C] Jrst Replac .Iot DSKo,A Jrst prloop Replac: Skipn AorP Jrst Done Skipe IFile Jrst Rename Syscal DELEWO,[%Climm,,DSKi] .Lose %LsFil Rename: Syscal RENMWO,[%Climm,,DSKo ? FN1 ? FN2] .Lose %LsFil Done: Type "AWritten to " Call FType Die: .Logout 1, ;; ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;; PDList: -PDLen,,PDList Block PDLen JCLbuf: Block JCLen -1 Device: Sixbit /DSK/ Sname: 0 FN1: 0 FN2: Sixbit />/ DOW: 6,,[Asciz /Sunday/] 6,,[Asciz /Monday/] 7,,[Asciz /Tuesday/] 9.,,[Asciz /Wednesday/] 8.,,[Asciz /Thursday/] 6,,[Asciz /Friday/] 8.,,[Asciz /Saturday/] Fillen: 0 Create: 0 IFile: 0 Quote: 0 Alpha: 0 MaxLen: 2000*5 Page: 0 AorP: 0 Jname: 0 Jname7: Block 2 Jnamel: 0 pText: 0 SChar: ^C ? ^D ? ^F ? ^G ? ^L ? ^Q ? ^R ? ^U ? ^W ? ^Y ? 177 ? %Tjdis+"H SHand: Save ? Quitp ? CtrlF ? Quitp ? CtrlL ? SQuote ? CtrlR CtrlU ? CtrlW ? Yank ? Delete ? Help ? Yank NSChar==SHand-SChar KilBuf: Block KILen LKBuf: 0 ;;; ;;;;; ;;; AddPag: Sos Page Syscal CORBLK,[%Climm,,%CBPRV %Climm,,%JSELF Page %Climm,,%JSNEW] .Lose %LsSys Movei T1,2000*5 Addm T1,MaxLen Return 6Type: Setz T2, Rotc T1,6 Addi T2,40 Syscal IOT,[T3 ? T2] .Lose %LsSys Jumpn T1,6Type Return FType: Movei T3,TTYo Move T1,Device Call 6Type .Iot TTYo,[":] .Iot TTYo,[" ] Move T1,Sname Call 6Type .Iot TTYo,[";] .Iot TTYo,[" ] Move T1,FN1 Call 6Type .Iot TTYo,[" ] Move T1,FN2 Call 6Type Return CLine: .Iot TTYo,[^P] .Iot TTYo,["H] .Iot TTYo,[8.] .Iot TTYo,[^P] .Iot TTYo,["L] Return ReLine: Skipn T Return Move B,T top1: Jumpe B,bot1 Ldb T1,D Cain T1,^J Jrst bot1 Soj B, DBP D Jrst top1 bot1: Move C,T Sub C,B Syscal SIOT,[%Climm,,TTYo ? D ? C] .Lose %LsSys Return DelChr: Ldb A,D Soj T, DBP D Cain A,^J Jrst [.Iot TTYo,[^P] .Iot TTYo,["U] Ldb A,D Caie A,^M Return Jrst DelChr] Cain A,^M Jrst [Call ReLine Return] Caie A,177 Caige A,40 Skipa Jrst bi uni: .Iot TTYo,[^P] .Iot TTYo,["X] bi: .Iot TTYo,[^P] .Iot TTYo,["X] Return DateIt: .RYear T1, Ldb T2,[320300,,T1] ;bits 3.9-4.2, day of week Move T1,DOW(T2) Hlrz T3,T1 ;len Hrli T4,440700 Hrr T4,T1 ;loc Syscal SIOT,[%Climm,,DSKo ? T4 ? T3] ;"Sunday", etc .Lose %LsSys .Iot DSKo,[" ] Movei T3,DSKo .RDatim A, ;HHMMSS -> A, YYMMDD -> B Rotc B,6*2 ;xxxxYY -> C Move D,B ;MMDDxx -> D Rotc D,6*2 ;xxxxMM -> E, DDxxxx -> D Move T1,D Call 6Type .Iot DSKo,["/] Lsh E,6*4 Move T1,E Call 6Type .Iot DSKo,["/] Lsh C,6*4 Move T1,C Call 6Type .Iot DSKo,[" ] ;dd/mm/yy Setz B, Rotc A,6*2 ;xxxxHH -> B, MMSSxx -> A Lsh B,6 ;xxxHHx Addi B,32 ;xxxHH: Rotc A,6*2 ;xHH:MM Lsh B,6 ;HH:MMx Move T1,B Call 6Type ;hh:mm .Iot DSKo,[" ] Return JType: Move T1,Jnamel Move T2,[440700,,Jname7] Syscal SIOT,[%Climm,,TTYo ? T2 ? T1] .Lose %LsSys Return ;;; ;;;;; ;;; Variables Constants Death==._-12+1 ;The end of the road END Begin