;;;-*-Midas-*- subttl FORMAT .begin format ;;;The master copy of this library lives in AI:SYSENG;FORMAT >. ;;;Modification history: ;;; Alan 12/2/87 Added ~U. ;;; Alan 10/10/87 Added ~:H. $$ERRS defaults to 0 since nobody seems ;;; to want it usually. ~Q and ~F should now work ;;; inside justification. ;;; Alan 5/16/87 Fixed ~E to understand multi-line error messages. ;;; Alan 11/23/85 Added : flag to ~S (and ~F?). ;;; Alan 5/2/85 Added ~| and ~Q and $$TIME. ;;; Alan 1/26/85 New switch: ;;; $$IERR = 1, allow user supplied error macro ;;; CStacy ??? New switches: ;;; $$ITS = 0, not running under ITS ;;; $$ERRS = 0, ~E not enabled ;;; Alan 7/17/83 Installed FORMAT on SYSENG; comment   File: FORMAT, Node: Top, Up: (LIB), Next: Requirements FORMAT is a .INSRTable MIDAS library patterned after Lisp's FORMAT function. The Lisp FORMAT function traces its ancestry back to the FORTRAN FORMAT statement and to the ioa_ routine on Multics. This is simply the latest entry in a long tradition. * Menu: * Introduction:: Introduction to FORMAT for people who have never seen anything like it before. * Requirements:: Basic requirements and calling convention. * Operators:: Table of all operators. * Switches:: Varying the behavior of FORMAT to suit your application.  File: FORMAT, Node: Switches, Previous: Operators, Up: Top, Next: PCode For the most part FORMAT can function quite well without having \any/ switches set, most all operators are always assembled. (The single exception is the ~T operator currently.) Some switches allow the user to choose between different techniques FORMAT can use to accomplish the same ends. For example, the $$ITAB and $$UTAB switches allow the user to choose how the ~T operator keeps track of horizontal position. In some cases FORMAT can do a better job with some hints and assistance from the user. For example, the $$PCODE switch tells FORMAT that it is outputting to a display mode TTY channel so that it can use -codes to perform cursor positioning. Anyone reading this documentation for the first time should probably glance briefly at each node in the following menu, just to learn what the options are. * Menu: * PCode:: The $$PCODE switch, for when FORMAT is outputting to a display mode TTY. * ITab:: The $$ITAB switch, for when you can track horizontal position yourself. * UTab:: The $$UTAB switch, for when you want FORMAT to track horizontal position for you. * PFN:: The $$PFN switch allows FORMAT to call the RFN"PFN routine from the RFN library to print filenames. *Note RFN:(LIB)RFN. * Time:: The $$TIME switch allows FORMAT to call routines from the DATIME library to print dates and times. *Note DATIME:(LIB)DATIME. * Engl:: The $$ENGL switch can be used to disable the english number printer to conserve space. * IErr:: The $$IERR switch controls the way FORMAT signals errors. * Errs:: The $$ERRS switch controls the ~E operator. * ITS:: The $$ITS switch says FORMAT is running under the ITS operating syste.  File: FORMAT, Node: Introduction, Previous: Top, Up: Top, Next: Requirements If anyone needs this introduction, I refer them to the Lisp Machine manual's documentation for the FORMAT function. Perhaps someday I will write something here myself.  File: FORMAT, Node: Operators, Previous: Requirements, Up: Top, Next: Switches FORMAT operators are introduced by the escape character tilde (~), as with the Lisp FORMAT function. Each operator is identified by a single character following the tilde, for example the two character sequence ~D is the format operator for printing a number in decimal. Additionally, various "infix" arguments are allowed between the tilde and the identifying character. A sequence of digits is a numeric "parameter"; it is interpreted in decimal. (Unlike the Lisp FORMAT, only a single parameter is permitted.) Also the characters colon (:) and atsign (@) may appear in the infix argument, they are simply "flags" that modify the behavior of the operator in some binary way. Instead of a sequence of digits the character "v" may appear as an infix argument. In this case the next FORMAT argument is gobbled and it is used as the parameter. This is mostly useful with the ~R, ~T and ~< operators. Here is a table of all currently defined FORMAT operators. ~% Outputs a carrage return. ~n% outputs n carrage returns. No argument is gobbled. ~& Advances to a fresh line. ~n& advances to a fresh line and outputs n-1 carrage returns. No argument is gobbled. FORMAT's ability to bring you to a fresh line without extraneous carrage returns depends on the settings of the $$PCODE, $$ITAB and $$UTAB switches. if none of those switches is set, then ~& behaves exactly like ~%. ~A One argument is gobbled. It should be a byte pointer to an ASCIZ string which is to be output. -1 and 0 in the left half are both equivalent to 440700. ~B One argument is gobbled. It is output as a number in binary. ~C One argument is gobbled. It is output as a single character. Control characters are output as a two character sequence starting with ^. ~:C just outputs the character, even if it is a control character. ~D One argument is gobbled. It is output as a number in decimal. ~E The error message associated with the channel currently in .BCHN is output (in all lower case). Normally this is the error message associated with the most recent error (.CALL that failed to skip, or whatever). ~:E gobbles one argument, which should be an ITS error code, and prints the associated error message. The @ flag causes the first character of the error message to be capitalized. This operator is not assembled unless the $$ERRS flag is set. See *Note Errs:Errs. ~F One argument is gobbled. It should be a pointer to a four-word block containing an ITS filename. (In the usual order: device, first filename, second filename, directory.) The filename is printed in the standard way. If the $$PFN flag is set, then FORMAT will call the RFN"PFN routine from the RFN library. See *Note PFN:PFN. ~H One argument is gobbled. It is printed in octal halfword format similar to H mode in DDT (In fact the algorithm is borrowed from DDT). -105 is printed as "-1,,-105" etc. ~:H is the same except the left half is omitted when it would be redundant. (That is, 777 is printed as "777" rather than "0,,777" and -1 is printed as "-1" rather than "-1,,-1".) ~O One argument is gobbled. It is printed in octal. ~P The previously gobbled argument is re-examined. If it is 1, nothing is output, otherwise "s" is output. No new arguments are gobbled. ~:P is the same except instead of re-examining the previous argument, a new argument is gobbled. (Note that the sense of the colon flag is reversed from the Lisp FORMAT function's ~P operator.) ~@P and ~:@P are similar except if the argument is 1 then "y" is output, otherwise "ies" is output. ~Q One argument is gobbled. It is interpreted as a date and time in ITS disk format and output. ~:Q outputs just a time. ~@Q outputs just a date. This operator is not assembled unless the $$TIME switch is set. See *Note Time:Time. ~R ~nR gobbles one argument and outputs it in base n. ~R (no parameter) gobbles one argument and outputs it in english ("one", "two", "three", etc.). ~:R outputs an ordinal number ("first", "second", "third", etc.). The @ flag causes the first character of the first word output to be capitalized. FORMAT's english number printing facilities can be disabled by use of the $$ENGL switch to save space, see *Note Engl:Engl. ~S One argument is gobbled. It is interpreted as a word of SIXBIT and output. ~:S prints in lower case. ~T ~nT outputs enought tabs and spaces to advance the output to a horizontal position of n. If the output is already beyond that column, nothing is output. This operator is not assembled unless one of the switches $$ITAB or $$UTAB is set. No arguments are gobbled. (See *Note ITab:ITab, and its Next for details.) ~U One argument is gobbled. It is interpreted as a word of SQUOZE and output. ~X ~X gobbles one argument. It is output in hexidecimal. ~| If $$PCODE is set, ~| clears the screen. If $$PCODE is not set, ~| outputs a formfeed. In both cases ~n| then outputs n-1 carrage returns. ~~ Outputs a tilde. No argument is gobbled. ~ Occasionally it may be necessary to insert a carrage return in a long FORMAT control string to improve readability. The ~ operator allow this to be done gracefully. ~ simply discards the carrage return and any leading whitespace on the next line and then continues processing the control string. ~@ outputs the carrage return and discards the whitespace. ~: discards the carrage return and outputs the whitespace. ~:@ outputs both, and is therefore a no-op. No argument is gobbled. ~< These three operators provide a justification feature. ~; ~n processes the two strings "ll...ll" and ~> "rr...rr" and outputs them with as many copies of the character "c" between them as is necessary to fill up exactly n characters. So for example, to print a decimal number in a 6 column field padded on the left with zeros, one could write: "~6<~;0~D~>". If the output cannot possibly fit, no copies of the padding character will be output and the resulting text will simply be too long. By special dispensation, if the lefthand string is empty, and the padding character is a space, then the "~; " may be omitted. Thus to output a decimal number in 6 columns padded on the left with spaces, one could simply write: "~6<~D~>". A few operators are illegal within the strings "ll...ll" and "rr...rr", mostly those having to do with knowing horizontal position. They are: ~%, ~&, ~T and ~<. The last means that recursive justifications are not currently supported. Note that unlike ~T, the justification feature counts characters, rather than computing horizontal position.  File: FORMAT, Node: Requirements, Previous: Top, Up: Top, Next: Operators FORMAT requires no static storage, it keeps all of its state on the stack (including its small output buffer). It is completely pure, and completely reentrant. FORMAT stack frames are relatively large, about 20. to 30. words. Keep this in mind when you are allocating your PDL! The following accumulators must be defined: A, B, C, D, E, and P. C must be B+1. P must be the pdl-pointer. OUTSTR must be defined. It should be a routine for printing an ASCII string. This is what FORMAT calls to output characters. FORMAT does not define any symbols outside of its own symbol block, named FORMAT. (See *Note Blocks:(Midas)Blocks, for a review of Midas block structure.) Thus, for example, FORMAT's entrypoint is usually written FORMAT"FORMAT by the caller. Calling convention: When FORMAT"FORMAT is called it expects A to contain a byte pointer to an ASCII string. B should contain the length of that string in characters. C should contain minus the number of arguments being passed to FORMAT. Those arguments should have been pushed on the PDL (in order) before FORMAT was called. The return address will be found below those arguments. FORMAT returns by popping the arguments off the stack and then doing a POPJ P,. A typical call to FORMAT might look like: push p,[foo69] push p,errors push p,trials hrroi a,[ascii "~&~D error~P in ~D trial~P."] movei b,.length "~&~D error~P in ~D trial~P." movni c,2 jrst format"format foo69: Obviously a little macrology can sugar this up to be not quite so cumbersome. See *Note Macro:Macro, for a possible candidate. Notice, by the way, that a -1 or a 0 in the left half of the byte pointer passed to FORMAT in A will be treated as if it were 440700. FORMAT calls the routine OUTSTR to do output with a byte pointer in A, character count in B. That routine mustn't clobber D or E, but C is fair game. It is called by PUSHJ P,OUTSTR. A likely OUTSTR might be: outstr: .call [setz ? sixbit /siot/ movei ttyo move a setz b] .lose %lssys popj p,  File: FORMAT, Node: PFN, Previous: UTab, Up: Switches, Next: Time By default $$PFN==0. If $$PFN==0 then ~F will simply format a filename like: "~S: ~S; ~S ~S" If $$PFN==1 then the ~F operator will work by calling the routine PFN, which you must supply somehow. It will be invoked as if it is the RFN"PFN routine from the RFN library. (*Note RFN:(LIB)RFN.) Typically setting $$PFN==1 will look something like: rfn"$$pfn==:1 .insrt dsk:syseng;rfn > format"$$pfn==:1 format"pfn==:rfn"pfn .insrt dsk:syseng;format > FORMAT assumes that no filename can require more than 54 characters to print (including quotes, and including a potential ^@ after the last character deposited). Of course it needn't really be RFN"PFN that format calls in this case, the routines RFN"PFNMCH and RFN"PFNBRF also have the same calling convention and can be used instead. Indeed, any routine can be used as long as it has the same calling convention and doesn't deposit more than 54 characters!  File: FORMAT, Node: Time, Previous: PFN, Up: Switches, Next: Engl By default $$TIME==0. If $$TIME==1 then the ~Q operator is enabled. It will format dates and times by calling the routines FORMAT"DATIME, FORMAT"TIME, and FORMAT"DATE in order to implement ~Q, ~:Q, and ~@Q respectively. These routines are all invoked as if they were output routines from the DATIME library. (*Note DATIME:(LIB)DATIME.) Typically setting $$TIME==1 will look something like: datime"$$out==:1 .insrt dsk:syseng;datime > format"$$time==:1 format"datime==:datime"twdasc format"time==:datime"timasc format"date==:datime"datasc .insrt dsk:syseng;format > FORMAT assumes that no date or time requires more than 35 characters to print. (This is easily true of all the routines in DATIME.)  File: FORMAT, Node: Engl, Previous: Time, Up: Switches, Next: IErr By default $$ENGL==1. If $$ENGL==1, then FORMAT's english number printing routines are assembled. This enables ~R, ~:R, ~@R and ~:@R. If you are tight for space, you can set $$ENGL==0 and save about 250 words.  File: FORMAT, Node: ITS, Previous: Errs, Up: Switches By default $$ITS==1. If $$ITS==0, then FORMAT will not assume that it is running under ITS timesharing.  File: FORMAT, Node: Errs, Previous: IErr, Up: Switches, Next: ITS By default $$ERRS==0. If $$ERRS==1, then the ~E operator is enabled and ERRI must be defined. It should be a channel on which FORMAT can open the ERR device if need be.  File: FORMAT, Node: IErr, Previous: Engl, Up: Switches, Next: Errs By default $$IERR==0. If $$IERR==1 then FORMAT will expect the user to define a macro named FMTERR that FORMAT will use to signal errors. It should expect a single macro argument of a string of text surrounded by doublequotes. If $$IERR==0 then format uses the following macro: define fmterr *text* .value .+2 jrst .-1 asciz ":text " termin  File: FORMAT, Node: PCode, Previous: Switches, Up: Switches, Next: ITab By default $$PCODE==0. If $$PCODE==1 then FORMAT is allowed to output ^P codes. This is different from allowing the caller to include ^P codes in his FORMAT control string. The only restriction on the latter is that if $$UTAB==1 (*Note UTab:UTab.), then FORMAT will be confused by ^P codes not produced by FORMAT itself.  File: FORMAT, Node: ITab, Previous: PCode, Up: Switches, Next: UTab By default $$ITAB==0. If $$ITAB==1 then the ~T operator is enabled. The user should supply a routine named GETPOS to return the horizontal cursor position. The routine will be called using PUSHJ P,GETPOS. It should return the current horizontal cursor position in A. It should return -1 if the horizontal position is unknown. It mustn't clobber D or E, but B and C are fair game. A likely GETPOS might be: getpos: .call [setz ? sixbit /rcpos/ movei ttyo setzm a] skipa a,[-1] hrrz a,a popj p,  File: FORMAT, Node: UTab, Previous: ITab, Up: Switches, Next: PFN By default $$UTAB==0. If $$UTAB==1 then the ~T operator is enabled. FORMAT will keep track of horizontal position itself in this case. This requires that D should contain the starting horizontal position whenever FORMAT"FORMAT is called. When FORMAT returns, D will contain the updated horizontal position. A GETPOS routine is NOT required. The algorithm FORMAT uses to compute horizontal position is the same as that employed by EMACS when it displays a file without SAIL characters enabled. That is, most control characters are two characters wide, including ^H (backspace) and isolated ^M's (carrage return) and ^J's (line feed). ^M immediately followed by ^J resets horizontal position to 0. ^I (tab) characters are understood to advance the horizontal position to the next multiple of 8 (and at least to advance it by 1).  File: FORMAT, Node: Macro Here is a simple macrology for calling FORMAT: The user writes: format "~&~D error~P in ~D trial~P.",[errors,trials] This macro expands into a single instruction, so that it can be skipped over. All accumulators are saved and restored. The arguments written in the IRP list after the control string can refer to any location and will find the expected value there, EXCEPT for P. define format &string&,args pushj p,[ pushj p,fmtin zzz==-1 irp arg,,[args] push p,arg zzz==.irpcnt termin hrroi a,[ascii string] movei b,.length string movni c,zzz+1 jrst format"format] termin fmtin: push p,a push p,b push p,c push p,[fmtout] jrst @-4(p) fmtout: pop p,c pop p,b pop p,a pop p,(p) popj p,   ;end comment .auxil ;Don't cref me please. .tyo6 .ifnm1 .tyo 40 .tyo6 .ifnm2 fmtvrs==:.ifvrs printx / included in this assembly. / ifn b+1-c, .err FORMAT requires C=B+1 ifndef $$pcode, $$pcode==0 ;can use ^P codes ifndef $$itab, $$itab==0 ;~T and ~& can call GETPOS to do their job. ifndef $$utab, $$utab==0 ;format itself is tracking the hpos. ifndef $$pfn, $$pfn==0 ;PFN routine prints filenames. ifndef $$engl, $$engl==1 ;English number printing is enabled. ifndef $$time, $$time==0 ;Date and time printing is enabled. ifndef $$ierr, $$ierr==0 ;User has defined a fmterr macro for us. ifndef $$its, $$its==1 ;Running under ITS. ifndef $$errs, $$errs==0 ;Error code/message printing is enabled. ifn $$utab, ifn $$itab, .err $$ITAB and $$UTAB simultaneously non-zero. ife $$its,[ ifn $$errs, .err ~E feature only available under ITS ife $$ierr, .value==jrst 4, ];ife $$its ife $$ierr,[ define fmterr *text* .value .+2 jrst .-1 asciz ":text " termin ] ;ife $$ierr call==pushj p, return==popj p, jcall==jrst ;;;Flags are kept in left half of E. %fmcol==1_17. ;Colon flag, sign bit of E %fmats==1_16. ;Atsign flag %fmnum==1_15. ;Numeric argument seen. %fmv==1_14. ;~vX type numeric argument seen. %fmjst==1_13. ;Set during a justification. %fmbuf==1_12. ;Indicates that a justification is still ;possible on characters still in the ;buffer. If $$UTAB==1 then the characters ;in the buffer have not been counted into ;HPOS yet. Cleared whenever the buffer is ;dumped. %fmcrl==1_11. ;If $$UTAB==1, this bit remembers that a ^M ;was the last character out in case the ;next one is ^J. %fmeng==1_10. ;Internal to the english number printer. ifn $$utab,[ define tyo x ifn c-x, move c,x format"call format"%tyo termin ] ;end ifn $$utab ife $$utab,[ define tyo x idpb x,format"obp(e) sosg format"bufct(e) format"call format"dump termin ] ;end ife $$utab define nojust tlne e,format"%fmjst format"call format"bdjust termin define nextarg x,inst=move move x,format"argptr(e) aobjp x,format"nxarg movem x,format"argptr(e) inst x,(x) termin define getarg x,inst=move move x,format"argptr(e) inst x,(x) termin format: push p,d save.d=400000 ;saved contents of D hpos==save.d ;If $$UTAB==1, this is hpos. movei d,-1(p) add d,c push p,d save.p=400001 ;saved pdl height hrli d,-1(c) push p,d argptr=400002 ;AOBJP Argument pointer. push p,e save.e=400003 ;saved contents of E hrrzi e,-save.e(p) ;Flags all clear initially. hlrz c,a caie c,-1 ;0 or -1 in left half acts like 440700 skipn c hrli a,440700 push p,a bp=400004 ;Control string byte pointer. push p,[0] numarg=400005 ;numeric argument to operator. movei a,buffer(e) hrli a,440700 push p,a obp=400006 ;Output byte pointer. ibfsiz==10. ;50. character buffer initially. push p,[ibfsiz*5] bufct=400007 ;Output buffer count. push p,[0] just=400010 ;For justification push p,[ibfsiz*5] bufsiz=400011 ;Size of buffer is variable. repeat ibfsiz, push p,[ascii "_____"] buffer=400012 ;Buffer must be last. move d,b ;D: length of string loop: sojl d,done ;nothing left? scan: ildb c,bp(e) xloop: cain c,"~ jrst escape tyo c sojge d,scan done: call dump tlne e,%fmjst call eof hrrz c,p sub c,save.p(e) move d,save.d(e) move e,save.e(e) hrl c,c sub p,c return escape: movei c,1 movem c,numarg(e) ;default arg is 1 tlz e,%fmats\%fmcol\%fmnum\%fmv\%fmeng ;clear flags escp1: sojl d,eof ildb c,bp(e) jrst @esctbl(c) esctbl: repeat 200, nxop define defop char,handlr zzz==. loc format"esctbl+char handlr ifge char-"A,[ ifle char-"Z,[ loc format"esctbl+char+"a-"A handlr ]] loc zzz termin defop ":,opcolon opcolo: tloe e,%fmcol call bdop jrst escp1 defop "@,opatsign opatsi: tloe e,%fmats call bdop jrst escp1 defop "V,op.V op.V: tloe e,%fmnum\%fmv call bdop nextarg c movem c,numarg(e) jrst escp1 repeat 10., defop "0+.rpcnt,opdigit opdigi: tlne e,%fmv call bdop move a,numarg(e) tlon e,%fmnum setzi a, imuli a,10. subi c,"0 add a,c movem a,numarg(e) jrst escp1 defop "~,optilde optild: tyo c cloop: jrst loop defop "R,op.R defop "X,op.X op.R: tlnn e,%fmnum jrst englsh skipa a,numarg(e) op.X: movei a,16. jrst op.num defop "B,op.B op.B: movei a,2 jrst op.num defop "D,op.D defop "O,op.O op.D: skipa a,[10.] op.O: movei a,8 op.num: nextarg b call ntype jrst loop defop "H,op.H op.H: nextarg b caml b,[-4000] cail b,774000 skipa jumpl e,op.H1 hlrz b,b cail b,774000 hrre b,b movei a,8 call ntype movei c,", tyo c movei c,", tyo c getarg b,hrrz cail b,774000 hrre b,b op.H1: movei a,8 call ntype jrst loop ifn $$engl,[ englsh: nextarg b push p,cloop jumpe b,eng0 jumpg b,eng1 movei a,$minus call prinz movn b,b jumpl b,ensetz eng1: cail b,10000. jrst eng1E9 move a,b idivi b,100. idivi b,10. move b,a jumpe c,eng1E3 tlo e,%fmeng jcall engb eng0: movei a,$0 tlne e,%fmcol movei a,$0th jcall prinz ;;;An inordinate number of instructions have been written in this world to ;;;compensate for the fact that in two's-compliment binary there is an ;;;extra negative number: ensetz: idiv b,[1000000000.] movn b,b movn c,c jrst eng1E8 eng1E9: idiv b,[1000000000.] eng1E8: move a,[$billion,,eng1E6] jrst engil eng1E6: idiv b,[1000000.] move a,[$million,,eng1E3] jrst engil eng1E3: idivi b,1000. eng1E2: move a,[$thousand,,eng1E0] jrst engil eng1E0: tlo e,%fmeng jcall engb engil: exch b,c jumpe c,(a) push p,a push p,b call engc pop p,b hlr a,(p) call prinz jumpn b,sppopj pop p,(p) jumpge e,cpopj thpopj: movei a,[asciz "th"] jcall prinz sppopj: movei c,40 tyo c return ;;;Still within IFN $$ENGL: ;;;Subroutine. Outputs C(B) in english. 0 < C(B) < 10000., but not ;;;1000.|C(B). ENGC prints C(C), ENGB prints C(B). If %FMENG and %FMCOL are ;;;set, then we output an ordinal number. engc: move b,c engb: idivi b,100. jumpe b,engx2 push p,c tlze e,%fmeng tlnn e,%fmcol jrst engx1 call eng100 movei a,$hundred call prinz pop p,b jumpe b,thpopj movei a,$and call prinz tlo e,%fmeng jcall eng100 engx1: call eng100 movei a,$hundred call prinz pop p,b jumpn b,eng140 return engx2: move b,c jcall eng100 ;;;Subroutine. Outputs C(B) in english. 0 < C(B) < 100.. ;;;ENG140 prints a space first, ENG100 does not. If %FMENG is set, we ;;;output an ordinal number. eng140: movei c,40 tyo c eng100: caige b,20. jrst eng102 idivi b,10. move a,C$20-2(b) move b,c call prinz jumpe b,eng103 movei a,[asciz "y-"] call prinz eng102: move a,C$1-1(b) tlne e,%fmeng hlr a,a prinz: hrli a,440700 tlzn e,%fmats ;Atsign flag causes capitalization jrst prinz0 ildb c,a subi c,"a-"A prinz1: tyo c prinz0: ildb c,a jumpn c,prinz1 return eng103: tlne e,%fmeng jrst eng104 movei c,"y tyo c return eng104: movei a,[asciz "ieth"] jcall prinz ;;;Still within IFN $$ENGL: C$1: $1th,,$1 ? $2th,,$2 ? $3th,,$3 ? $4th,,$4 ? $5th,,$5 ? $6th,,$6 $7th,,$7 ? $8th,,$8 ? $9th,,$9 ? $10th,,$10 ? $11th,,$11 $12th,,$12 ? $13th,,$13 ? $14th,,$14 ? $15th,,$15 ? $16th,,$16 $17th,,$17 ? $18th,,$18 ? $19th,,$19 C$20: $20 ? $30 ? $40 ? $50 ? $60 ? $70 ? $80 ? $90 $minus: asciz "minus " $and: asciz " and " $0: asciz "zero" $0th: asciz "zeroth" $1: asciz "one" $1th: asciz "first" $2: asciz "two" $2th: asciz "second" $3: asciz "three" $3th: asciz "third" $4: asciz "four" $4th: asciz "fourth" $5: asciz "five" $5th: asciz "fifth" $6: asciz "six" $6th: asciz "sixth" $7: asciz "seven" $7th: asciz "seventh" $8: asciz "eight" $8th: asciz "eighth" $9: asciz "nine" $9th: asciz "ninth" $10: asciz "ten" $10th: asciz "tenth" $11: asciz "eleven" $11th: asciz "eleventh" $12: asciz "twelve" $12th: asciz "twelfth" $13: asciz "thirteen" $13th: asciz "thirteenth" $14: asciz "fourteen" $14th: asciz "fourteenth" $15: asciz "fifteen" $15th: asciz "fifteenth" $16: asciz "sixteen" $16th: asciz "sixteenth" $17: asciz "seventeen" $17th: asciz "seventeenth" $18: asciz "eighteen" $18th: asciz "eighteenth" $19: asciz "nineteen" $19th: asciz "nineteenth" $20: asciz "twent" $30: asciz "thirt" $40: asciz "fort" $50: asciz "fift" $60: asciz "sixt" $70: asciz "sevent" $80: asciz "eight" $90: asciz "ninet" $hundr: asciz " hundred" $thous: asciz " thousand" $milli: asciz " million" $billi: asciz " billion" ] ;end ifn $$engl defop "A,op.A op.A: nextarg a hlrz c,a caie c,-1 ;0 or -1 in left half acts like 440700 skipn c hrli a,440700 jrst op.A1 op.A2: tyo c op.A1: ildb c,a jumpn c,op.A2 jrst loop defop "S,op.S op.S: nextarg a call 6type jrst loop defop "C,op.C op.C: nextarg a jumpl e,op.C1 ;If colon set, just tyo it. cail a,40 ;Normal printing characters just tyo'd cail a,177 jrst op.C2 op.C1: tyo a jrst loop op.C2: cain a,33 ;altmode just gets tyo'd jrst op.C1 movei c,"^ tyo c trc a,100 jrst op.C1 defop "P,op.P op.P: jumpl e,op.P1 ;Colon flag reversed from Lisp version. getarg c tlne e,%fmats jrst op.P2 op.P3: cain c,1 jrst loop op.Ps: movei c,"s tyo c jrst loop op.P1: nextarg c tlnn e,%fmats jrst op.P3 op.P2: cain c,1 jrst op.P4 movei c,"i tyo c movei c,"e tyo c jrst op.Ps op.P4: movei c,"y tyo c jrst loop ; SQUOZE ASCII ; 0 "/" 57 ; 1 - 12 "0" - "9" 60 - 71 ; 13 - 44 "A" - "Z" 101 - 132 ; 45 "." 56 ; 46 "$" 44 ; 47 "%" 45 defop "U,op.U op.U: nextarg b tlz b,740000 op.U1: idiv b,[50*50*50*50*50] addi b,"A-13 caige b,"A subi b,<"A-1>-"9 caile b,"Z subi b,<"Z+2>-"$ cain b,"$-1 movei b,". exch b,c tyo c imuli b,50 jumpn b,op.U1 jrst loop ifn $$errs,[ defop "E,op.E op.E: jumpl e,op.E4 ;If colon flag is set, arg is error code. movei a,1 op.E1: .call op.Ecl .lose %lssys tlnn e,%fmats ;If atsign flag is set, Capitalize first word. jrst op.E3 .iot erri,c jrst op.E2 op.E5: movei c,", tyo c movei c,40 tyo c op.E6: movei c,"a-"A(a) cail c,"a caile c,"z subi c,"a-"A op.E2: tyo c op.E3: .iot erri,a cail a,40 jrst op.E6 caie a,^M jrst op.E9 .iot erri,a caie a,^J jrst op.E9 .iot erri,a cail a,40 jrst op.E5 op.E9: .close erri, jrst loop op.E4: nextarg b movei a,4 jrst op.E1 op.Ecl: setz sixbit /open/ [.uai,,erri] [sixbit /err/] move a setz b ];$$errs ife $$pfn,[ defop "F,op.F op.F: nextarg a push p,2(a) ;fn2 push p,1(a) ;fn1 push p,3(a) ;dir move a,0(a) ;dev call 6type movei c,": tyo c movei c,40 tyo c pop p,a call 6type movei c,"; tyo c movei c,40 tyo c pop p,a call 6type movei c,40 tyo c pop p,a call 6type jrst loop ] ;end ife $$pfn ifn $$pfn,[ defop "F,op.F op.F: movei b,54. ;maximum size of filename including jsp a,grow ; the ^@ at the end. push p,d move d,obp(e) nextarg b call pfn move a,d pop p,d call nstr jrst loop ] ;end ifn $$pfn ifn $$time,[ defop "Q,op.Q op.Q: movei b,35. jsp a,grow push p,d move d,obp(e) nextarg a tlnn e,%fmcol\%fmats call datime tlne e,%fmcol call time tlne e,%fmats call date move a,d pop p,d call nstr jrst loop ] ;end ifn $$time defop ^M,opcrlf opcrlf: tlne e,%fmats call crlf sojl d,done ildb c,bp(e) caie c,^J ;flush linefeed if it is there jrst nolf jumpl e,loop ;If colon set, we are done. skpws1: sojl d,done ildb c,bp(e) skipws: caie c,40 cain c,^I jrst skpws1 jrst xloop nolf: jumpge e,skipws ;If colon not set, skip white space. jrst xloop ife $$pcode,[ defop "|,opvbar opvbar: movei c,^L tyo c sosg a,numarg(e) jrst loop jrst op.%1 ] ;end ife $$pcode ;;;~& is the same as ~% if you can't orient yourself: ife $$pcode\$$itab\$$utab, defop "&,op.% defop "%,op.% op.%: skipg a,numarg(e) jrst loop op.%1: call crlf sojg a,op.%1 jrst loop ifn $$pcode,[ defop "|,opvbar defop "&,opamper opvbar: skipa a,["C] opampe: movei a,"A opamp1: nojust movei c,^P tyo c tyo a ifn $$utab, setzm hpos(e) sosg a,numarg(e) jrst loop jrst op.%1 ] ;end ifn $$pcode defop "<,oples oples: call dump tloe e,%fmjst\%fmbuf call bdjust tlnn e,%fmnum call bdop move b,numarg(e) jsp a,grow ;Make sure buffer is big enough. oples3: movei c,40 hrl c,numarg(e) movem c,just(e) jrst loop defop 73,opsemi ;"; (Emacs and Midas both give you grief if ; you actually write a semicolon here...) opsemi: tlnn e,%fmjst call bdop sojl d,eof ildb a,bp(e) tlnn e,%fmbuf ;buffer overflew, no justification. jrst loop move c,bufsiz(e) sub c,bufct(e) jumpe c,opsmi1 hlrz b,just(e) sub b,c jumple b,loop ;already no more room, no padding needed. hrl a,b movem a,just(e) call dump tlo e,%fmbuf jrst loop opsmi1: hrrm a,just(e) jrst loop defop ">,opgrt opgrt: tlzn e,%fmjst call bdop tlnn e,%fmbuf ;buffer overflew, no justification. jrst loop move c,bufsiz(e) sub c,bufct(e) hlrz b,just(e) sub b,c jumple b,opgrt7 ;no padding needed. move a,obp(e) push p,a push p,b hrrz c,just(e) opgrt9: idpb c,a ifn $$utab, call pos sojg b,opgrt9 pop p,b pop p,a call outstr opgrt7: call dump jrst loop ifn $$itab,[ ife $$pcode,[ defop "&,opamper opampe: nojust call dump call getpos jumpn a,op.% sose numarg(e) jrst op.% jrst loop ] ;end ife $$pcode defop "T,op.T op.T: nojust tlnn e,%fmnum call bdop call dump call getpos jumpl a,loop move b,numarg(e) camg b,a jrst loop rot b,-3 ;Only works for 8 character wide tabs. rot a,-3 sub b,a hrrz a,b lsh b,-33. jumpe a,op.T2 movei b,^I op.T1: tyo b sojg a,op.T1 ldb b,[000300,,numarg(e)] jumpe b,loop op.T2: movei a,40 op.T3: tyo a sojg b,op.T3 jrst loop ] ;end ifn $$itab ifn $$utab,[ %tyo: idpb c,obp(e) sosg bufct(e) jrst tyodmp %tyo1: tlne e,%fmbuf return pos: tlze e,%fmcrl jrst poscrl posfoo: cail c,40 cain c,177 jrst poscc aos hpos(e) return tyodmp: push p,c call dump pop p,c jrst %tyo1 poscrl: caie c,^J jrst posfoo setzm hpos(e) return poscc: cain c,^I jrst postab cain c,^M tloa e,%fmcrl caie c,33 aos hpos(e) aos hpos(e) return postab: exch c,hpos(e) addi c,10 ;Only works for 8 character wide tabs. andcmi c,7 exch c,hpos(e) return ;;; still in ifn $$utab ife $$pcode,[ defop "&,opamper opampe: nojust skipn hpos(e) sose numarg(e) jrst op.% jrst loop ] ;end ife $$pcode defop "T,op.T op.T: nojust tlnn e,%fmnum call bdop move b,numarg(e) move a,hpos(e) camg b,a jrst loop rot b,-3 rot a,-3 sub b,a hrrz a,b lsh b,-33. jumpe a,op.T2 op.T1: movei c,^I tyo c sojg a,op.T1 ldb b,[000300,,numarg(e)] jumpe b,loop op.T2: movei c,40 tyo c sojg b,op.T2 jrst loop ] ;end ifn $$utab ;;;Make room in the buffer for B more characters. Called by JSP A,GROW: grow: sub b,bufct(e) jumple b,(a) addi b,4 idivi b,5 ;B: how many words we need. movei c,5 imul c,b ;C: how many characters that will add to addm c,bufsiz(e) ; the buffer. addm c,bufct(e) push p,[ascii "_____"] sojg b,.-1 jrst (a) ;;;Empty the buffer. dump: push p,b move b,bufsiz(e) move c,b exch c,bufct(e) sub b,c jumpe b,dump3 push p,a movei a,buffer(e) hrli a,440700 movem a,obp(e) ifn $$utab,[ tlnn e,%fmbuf jrst dump1 push p,a push p,b dump2: ildb c,a call pos sojg b,dump2 pop p,b pop p,a ] ;end ifn $$utab dump1: call outstr pop p,a dump3: tlz e,%fmbuf pop p,b return ;;;Outputs a crlf. crlf: movei c,^M tyo c movei c,^J tyo c return ;;;Types number in B in base A: ntype: jumpge b,ntype1 movei c,"- tyo c ntype1: idiv b,a movm b,b movm c,c ntype2: addi c,"0 caile c,"9 addi c,<"A-10.-"0> jumpe b,ntype3 hrlm c,(p) idiv b,a call ntype2 hlrz c,(p) ntype3: tyo c return ;;;Types the word in A in SIXBIT. In lowercase if colon flag is set. 6type: jumpe a,cpopj 6type1: ldb c,[360600,,a] addi c,40 tlne e,%fmcol jrst 6type2 6type3: tyo c lsh a,6 jumpn a,6type1 cpopj: return 6type2: cail c,"A caile c,"Z jrst 6type3 addi c,"a-"A jrst 6type3 ifn $$pfn\$$time,[ ;;;Cleanup for the case where a string has been deposited in the buffer by ;;;someone other than ourselves. New byte pointer is found in A. nstr: move c,a exch a,obp(e) skipge a sub a,[430000,,1] ;In case A is 440700,,1 and B is 010700,,0 sub c,a jumpe c,cpopj ldb b,[360600,,c] imuli c,5 imuli b,55. lsh b,30. ash b,-30. subi b,(c) addm b,bufct(e) ifn $$utab,[ ;If we are tabbing, then we must update the HPOS tlne e,%fmbuf return nstr1: ildb c,a call pos aojl b,nstr1 ] ;end ifn $$utab return ] ;end ifn $$pfn\$$time ;;;Under construction: ;host printing ;flonum printing ;defop "?,opques ;Funcall escape. nxop: fmterr "Undefined format operator." bdop: fmterr "Bad call to format operator." ife $$engl, englsh==:bdop bdjust: fmterr "Illegal format operation during justification." eof: fmterr "Format string terminated unexpectedly." nxarg: fmterr "Format ran out of arguments." ;define sizhac size ;printx / (size!. words) ;/ ;termin ; ;oradix==10 ;radix 10. ;sizhac \.-format ;radix oradix .end format