IF2 .INEOF ; Never read on 2nd pass, nothing to re-define. IF1 IFDEF %%%MAC .INEOF ; This checks for file already .INSRT'd. %%%MAC==1 ; Aha, first! Prevent other .INSRT's from winning. ;---------------------------------------------------------------------------- ; Determine what OS to assemble for. To force a particular OS, ; simply set OS%==SIXBIT/foo/ where foo is one of ; ITS,CMU,SAIL,DEC,TENEX,TWENEX mutually exclusive. ; T10 equivalent to DEC ; T20,20X equivalent to TWENEX ; 10X equivalent to TENEX ; TNX indicates either 10X or 20X, macro determines which. ; The following symbols are defined by this section: ; Flag Set if assembling for: ; OS%ITS ITS system (AI,ML,MC,DM) ; OS%CMU CMU system ; OS%SAI SAIL system ; OS%T10 a vanilla Tops-10 system (neither SAIL nor CMU) ; OS%DEC set for all of the above 3 Tops-10 based systems. ; OS%10X BBN TENEX ; OS%20X DEC Tops-20 (TWENEX) ; OS%TNX set for both of the above 2 (10X or 20X). ifndef os%,os%==.osmidas %%t==0 irp pair,,[[ITS,its],[DEC,t10],[CMU,cmu],[SAIL,sail],[TENEX,10X],[TNX,tnx],[10X,10x],[20X,20x],[TWENEX,20x]] irp sys,flg,[pair] ife os%-sixbit/sys/, os%!flg==1 .else ifndef os%!flg, os%!flg==0 %%t==%%t+os%!flg .istop termin termin ife %%t,.err Can't determine OS to assemble for! expunge %%t ; Fixups... ifn os%tnx,[ ; If TNX of some kind, find exact variety. ife .osmidas-sixbit/tenex/, os%10x==1 .else os%20x==1 ] os%tnx==os%10x+os%20x ; TNX on if either 10X or 20X. os%t20==os%20x ; T20 synonym for 20X. os%dec==os%t10\os%cmu\os%sai ; DEC means a T10-like sys. ;------------------------------------------------------------------ ; Note: the following stuff is not completely thought out. Mainly it ; tries to ensure that a standard exists for specifying CPU type ; and that all CPU-dependent symbols are properly defined. ; This benefits various .insrt-able packages like NUUOS. ; Find what CPU to assemble for. To force a particular CPU, ; set CPU%==SIXBIT/foo/ where foo is one of: ; KA defaults to this. Standard vanilla PDP-10 ; KI very slightly hairier. ; KL current zenith, standard for 20X. ; K* means set flags to "good guess". ; RUNTIM means use run-time determination. ; The following symbols are defined by this section: ; CPU%KA set if should assemble specifically for KA ; CPU%KI " " " " " " KI ; CPU%KL " " " " " " KL ; CPU%X set if should use run-time determination. ; ; In general, code should be written to run on any processor. These ; flags are intended to be used only for special circumstances where ; the differences can be significant and binary portability is not ; as important. (For runtime determination of OS and CPU, see ; forthcoming .insrt-able routines, which should set variable flags ; of the form OS.TNX, CPU.KA, etc. ) ifndef cpu%, cpu%==sixbit/KA/ ; Always force to KA unless overridden irp pair,,[[KA,ka],[KI,ki],[KL,kl],[RUNTIM,x]] irp m,s,[pair] ife cpu%-sixbit/m/, cpu%!m==1 .else cpu%!m==0 termin termin ife cpu%-sixbit/K*/,{ ; Make good guess ifn os%20x, cpu%kl==1 .else cpu%ka==1 } ife cpu%ka\cpu%ki\cpu%kl\cpu%x, .err Can't determine CPU to assemble for! ;------------------------------------------------------------------ DEFINE INFORM A,B,C,D,E,F,G PRINTX \A!B!C!D!E!F!G \ TERMIN ; DEFAULT no-op'ing of purification macros if they're ; not already defined to do something. IFNDEF BVAR,[ DEFINE BVAR ; Make BVAR, EVAR, and LVAR all do nothing. TERMIN EQUALS EVAR,BVAR EQUALS LVAR,BVAR DEFINE VARCHK ; VARCHK always has this side effect. VARIABLES TERMIN ] ; Defs for ITS .CALL system call. IFN OS%ITS,[ CIMM==1000,,0 ; Immediate arg (also seen as MOVEI) CRET==2000,,0 ; Value returned (also seen as MOVEM) CERR==3000,,0 ; Error code returned CTL== 4000,,0 ; Control bits at loc CTLI==5000,,0 ; Control bits, immediate DEFINE SYSCAL A,B .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] TERMIN ] %SIGN==SETZ ; Define full-word Sign bit. %HSIGN==400000 ; and Halfword sign bit. ; Common byte-pointer LH's IFNDEF $OPCOD,$OPCOD==331100 ; Instruction op-code IFNDEF $ACFLD,$ACFLD==270400 ; Instruction AC field IFNDEF $IFLD,$IFLD==220400 ; Instruction (I) field (maybe shd be $XFLD) IFNDEF $ATFLD,$ATFLD==260100 ; Instruction @ field (maybe shd be $IFLD) IFNDEF $ERRCD,$ERRCD==220600 ; Error code from .STATUS wd (ITS only) IFNDEF $PFLD,$PFLD==360600 ; P field of byte pointer IFNDEF $SFLD,$SFLD==300600 ; S field of byte pointer ; Macro to decrement 7-bit byte ptr in ac (no checking) DEFINE MDBP7 AC,FOO ADD AC,[70000,,0] ; Increase P CAIG AC,0 ; Skip, SUB AC,[430000,,1] ; unless went off edge, in which case reset. TERMIN EQUALS MD7BPT,MDBP7 ; Remain compatible with old names EQUALS MDBPT, MDBP7 ; Page-size parameters, OS dependent IFNDEF PG$BTS,{ IFN OS%TNX, PG$BTS==9. ; # bits of address in a page. IFN OS%ITS, PG$BTS==10. } PG$SIZ==1_PG$BTS ; Page size in # words. PG$MSK==PG$SIZ-1 ; Mask for page address bits. ; Define some "instructions". IFNDEF P,P=:17 ? .ERR P undefined, using P=17. IFNDEF CALL,CALL==: ; More efficient than macro. IFNDEF RETURN,RETURN==: IFNDEF RET,RET==: IFNDEF CALRET,CALRET==:JRST ; Better name for PJRST. IFNDEF PJRST,PJRST==:JRST ; JRST to a popj'ing routine IFNDEF NOP,NOP=: ; What the hell. DEFINE PUSHAE AC,LIST IRP LOC,,[LIST] PUSH AC,LOC TERMIN TERMIN DEFINE POPAE AC,LIST IRP LOC,,[LIST] POP AC,LOC TERMIN TERMIN ; TMPLOC , - puts argument at given LOC ; without changing location counter outside macro call. DEFINE TMPLOC VAL,?ARG %%%TLC==. LOC VAL ARG LOC %%%TLC TERMIN IFNDEF %%%ASC,%%%ASC==0 ; Default is old mode, i.e. ASCNT [str] IFE %%%ASC,[ ; ASCNT [string] - produces word of ,, DEFINE ASCNT STR .LENGTH STR,,[ASCIZ STR]!TERMIN DEFINE LITSTR STRING [ASCNT [STRING]]TERMIN ; ASCSTR [string] - produces 2 words of constant string descriptor, ; ? DEFINE ASCSTR STR .LENGTH STR 440700,,[ASCIZ STR]!TERMIN ] ; end IFE %%%ASC IFE %%%ASC-1,[ ; New style, i.e. ASCNT /str/ DEFINE ASCNT &STR& .LENGTH STR,,[ASCIZ STR]!TERMIN DEFINE LITSTR &STR& [ASCNT STR]!TERMIN DEFINE ASCSTR &STR& .LENGTH STR 440700,,[ASCIZ STR]!TERMIN ] ; IFE %%%ASC-1 ; NETHANG - macro interface to use NETBLK call. Hangs until specified ; net channel changes state, or call times out. ; MOVEI AC, ; NETHANG ,AC,,[] ; failure return (timed out or non-winning new state) ; win return (changed to winning state) ; Always returns new state in AC. IFN OS%ITS,[ ; Only for ITS (in theory could hack for TNX) DEFINE NETHANG TIMOUT,AC,HANGST,NEWSTL JRST [ MOVEM AC,TMSTOR' MOVE AC,[TIMOUT] EXCH AC,TMSTOR SYSCAL NETBLK,[AC ? [HANGST] ? TMSTOR ? CRET AC] JRST .+1 IRP CODE,,[NEWSTL] CAIN AC,CODE JRST .+2 TERMIN JRST .+1] TERMIN ] ; IFN OS%ITS ; BLKINI, BLKADD - couple of hairy macros that take a given ; and turn it into repository of text, initialized by BLKINI ; added to by BLKADD ,[]. ; To dump text, simply stick someplace after all has been added. DEFINE BLKINI BLKNAM ; Initialize specified blockname. DEFINE BLKNAM ARG ARG TERMIN TERMIN DEFINE BLKADD BLKNAM,NEW ; Add stuff to specified blockname. BLKNAM [DEFINE BLKNAM ARG ARG]NEW TERMIN TERMIN IFN OS%ITS,[ ; Clock stuff really not used by anything much. ; Macro to clear clock and set frame time for interrupts DEFINE CLKSET (TMOLOC) PUSH P,A MOVE A,[600000,,TMOLOC] .REALT A, JFCL POP P,A TERMIN ;to enable clock interrupts DEFINE CLKON .SUSET [.SAPIRQC,,[%PIRLT]] ;turn off any pending realt .SUSET [.SIMASK,,[%PIRLT]] ;enable it TERMIN ;to disable DEFINE CLKOFF .SUSET [.SAMASK,,[%PIRLT]] TERMIN ] ; IFN OS%ITS ;------------------------------------------------------------- ; Old Super duper macro to make output a breeze. Requires UUOS. ; This stuff is obsoleted by an even more super-duper macro ; contained in the OUT output package, but can still be used for ; the sake of compatibility. IFNDEF $$OUUO,$$OUUO==0 ; Default is not to use old output UUOs. DEFINE FWRITE CH,LIST IFE $$OUUO, MOVEI OC,CH %F==0 IRP ITM,REM,[LIST] IFN %F,[%F==0 ? .STOP] IFNSQ [ITM] .GO O IFNDEF %%.!ITM, .GO O IRP ARG,,[REM] ? %%.!ITM CH,[ARG] ? .ISTOP ? TERMIN %F==1 ? .STOP .TAG O %%.TC CH,[[.LENGTH ITM,,[ASCII ITM]]] TERMIN TERMIN DEFINE MAKSTR LOC,LIST ; For making string in one fell swoop. BCONC FWRITE STRC,[LIST] ECONC LOC TERMIN DEFINE CONC LOC,LIST ; For concatenating stuff to existing string. BCONC LOC FWRITE STRC,[LIST] ECONC LOC TERMIN DEFINE DEFWR ITM,INSTR,INTNAM ; Make easy to define simple items. IFN $$OUUO,{ ; Use old output UUOs DEFINE %%.!ITM C,ARG OU!ITM C,ARG TERMIN .STOP } IFB [INSTR]{IFB [INTNAM] DEFX2 %%.!ITM,MOVE U3,OX!ITM .ELSE DEFX2 %%.!ITM,MOVE U3,INTNAM .STOP } IFB [INTNAM] DEFX2 %%.!ITM,INSTR,OX!ITM .ELSE DEFX2 %%.!ITM,INSTR,INTNAM TERMIN DEFINE DEFX2 WITM,INSTR,RTN DEFINE WITM C,ARG INSTR,ARG CALL OUT"RTN TERMIN TERMIN ;------------------- FWRITE item routines ------------------ ; item is in form "%%. ," ; Note that if item takes no argument and it is the last thing in FWRITE, ; a space should follow the comma, as in FWRITE CH,[[foo],WAI, ] ; Otherwise MIDAS botches it with no err message. DEFWR TLS,,OXLS ; "TLS" - Text, List String. DEFWR TA,MOVEI U1,OXAR ; "TA" - Text, Area. outputs whole area. DEFWR TS,MOVEI U3,OXS ; "TS" - Text, String. outputs string var. DEFWR N10,,OXN10. ; "N10" - Number, base 10 ; signed decimal value, DEFWR N9,,OXN10 ; "N9" - N10 without decimal point. Kludge. DEFWR N8,,OXN8 ; "N8" - Number, base 8. Signed octal value. EQUALS %%.OCT,%%.N8 ; "OCT" - N8 EQUALS %%.DEC,%%.N10 ; "DEC" - N9 DEFWR NFL,,OXNFL ; "NFL" - Number, FLoating. From MACLISP. DEFWR TI,MOVEI U1,OXC ; "TI" - Text Immediate. Outputs arg as char DEFWR TZ,MOVEI U3,OXZA ; "TZ" - Text ASCIZ. Outputs asciz string DEFWR TC,,OXTC ; "TC" - Text, Count. Outputs ASCNT string at arg DEFWR TPZ,,OXZ ; "TPZ" - Text, BP ASCIZ. c(ARG) is BP to asciz string DEFWR TPC,,OXPC ; "TPC" - Text, BP Count. c(ARG) is #,,[bp] DEFWR 6F ; "6F" - outputs c(arg) as sixbit without trailing bls DEFWR 6W ; "6W" - outputs all of c(arg) as sixbit DEFWR 6Q ; "6Q" - like 6F but puts ^Q in front of punct. chars ; Weird cookies IFN $$OUUO,[ DEFINE DEFWRN ITM,INSTR,UUO DEFINE %%.!ITM C,ARG INSTR U4,ARG UUO C,U4 TERMIN TERMIN DEFWRN RH,MOVE,OUNRH ; "RH" - outputs RH of c(ARG) in octal (6 chars) DEFWRN LH,HLRZ,OUNRH ; "LH" - outputs LH of c(ARG) in octal (6 chars) DEFWRN RHV,HRRZ,OUN8 ; "RHV" - rh(arg) as octal number, not bit pattern DEFWRN LHV,HLRZ,OUN8 ; "LHV" - lh(arg) as octal number DEFWRN RHS,HRRE,OUN8 ; "RHS" - rh(arg) as signed octal number DEFWRN LHS,HLRE,OUN8 ; "LHS" - lh(arg) as signed octal number DEFINE DEFWH ITM DEFINE %%.!ITM C,ARG %%.L!ITM C,ARG %%.TZ C,[[ASCIZ /,,/]] %%.R!ITM C,ARG TERMIN TERMIN DEFWH H ; "H" - outputs c(ARG) in halfwd format (LH,,RH) DEFWH HV ; "HV" - lhv,,rhv DEFWH HS ; "HS" - lhs,,rhs DEFINE %%.TZ$ C,ARG ; "TZ$" - Text ASCIZ crock. RH(c(arg)) is addr of asciz MOVE U4,ARG ; (like OUTZ C,@ARG but avoids more indirection) OUTZ C,(U4) TERMIN ] ; IFN $$OUUO IFE $$OUUO,[ DEFWR RH,HRRZ U3 ; RH(aval) - Right halfword, full. DEFWR LH,HLRZ U3,OXRH ; LH(aval) - Left halfword, full. DEFWR RHV,HRRZ U3,OXN8 ; RHV(aval) - RH as octal num, not bit pattern. DEFWR LHV,HLRZ U3,OXN8 ; LHV(aval) - LH as octal num, not bit pattern. DEFWR RHS,HRRE U3,OXN8 ; RHS(aval) - RH as signed octal num DEFWR LHS,HLRE U3,OXN8 ; LHS(aval) - LH as signed octal num DEFWR H,,OXHWD ; H(aval) - Halfword (123,,456) DEFWR HV ; HV(aval) - LHV,,RHV DEFWR HS ; HS(aval) - LHS,,RHS DEFWR TZ$,HRRZ U3,OXZA ; TZ$(a-[a-asciz]) like TZ(@A) but avoids ] ;IFE $$OUUO DEFINE %%.ERR C,ARG ; "ERR" - System error message. If arg is blank, IFN $$OUUO,MOVEI OC,C IFB [ARG] CALL OUT"OXERRL ; use last err, otherwise arg is error code .ELSE MOVE U3,ARG ? CALL OUT"OXERR TERMIN DEFINE DEFWRT ITM,RTN,OUTRTN DEFINE %%.!ITM!I C,ARG ; Def the "immediate" version. %%.!ITM C TERMIN IFN $$OUUO,{ DEFINE %%.!ITM C,ARG PUSH P,A IFNB [ARG] MOVE A,ARG .ELSE CALL TIMGET CALL RTN %%.TC C,A POP P,A TERMIN .STOP } ; IFN $$OUUO DEFINE %%.!ITM C,ARG IFB [ARG]{ ; If no arg, use current time. IFN OS%ITS, CALL OUT"UTMGTS IFN OS%TNX, SETO U3, } .ELSE MOVE U3,ARG MOVEI U1,OUT"OUTRTN CALL OUT"OXTXS TERMIN TERMIN DEFWRT WA,TIMDTM,OXTMDT ; "WA" - When, type A. "mm/dd/yy hh:mm:ss" DEFWRT WB,TIMEXP,OXTME ; "WB" - When, type B. "dd mmm yy hhmm zon" DEFWRT WC,TIMTIM,OXTMTS ; "WC" - When, type C. "hh:mm:ss" DEFWRT WD,LTMEXP,OXTMX ; "WD" - When, type D. "dd month yyyy hh:mm zon" ; "HN" - takes host # from arg and outputs number, performing ; simplifications where appropriate. Intended for use with new (HOSTS3) ; host table. ; Note that the $$OUUO==1 version is obsolete, and should be flushed asap. IFN $$OUUO,[ DEFINE DEFWRH ITM,RTN DEFINE %%.!ITM C,ARG MOVE U4,ARG LDB U3,[NETWRK"NW$BYT,,U4] ; If no string exists, check number. CAIN U3,12 ; Arpanet? PUSHJ P,[ IFDEF $$HST3,IFN $$HST3,.ERR You are going to lose. Flush the $$OUUO==1 !! TDNE U4,[777,,77700774] ; Are any extended bits set? POPJ P, ; If so, just print number (hack "/" fmt later) DPB U4,[170200,,U4] ; Move host # ahead of imp # LSH U4,-9. ANDI U4,377 POPJ P,] ; finally output old-form number RTN C,U4 ; not arpanet?? just print. TERMIN TERMIN DEFWRH HN,OUN8 ; Output host number in octal DEFWRH HND,OUN9 ; Ditto in decimal ; "HST" - takes host # from arg and outputs name or # ; This version works with new host table file DEFINE %%.HST C,ARG ; "HST" - takes host # from arg and outputs name or # PUSHAE P,[A,B,D] ;clobbered by HSTSRC routine SKIPN B,ARG MOVE B,OWNHST PUSHJ P,NETWRK"HSTSRC ;make A point to asciz name PUSHJ P,[ %%.HN C,B ; Output number. JRST POPJ1] OUTZ C,(A) POPAE P,[D,B,A] TERMIN ] ;IFN $$OUUO IFE $$OUUO,[ IRP ITM,,[HN,HND,HST] DEFINE %%.!ITM C,ARG MOVE U3,ARG CALL OUT"OX!ITM TERMIN TERMIN ] ;IFE $$OUUO ; Character Table Macros ; These macros facilitate use of 200-word arrays indexed by ; an ASCII character. A standard table definition is furnished which ; can be inserted where desired, and each insertion may be altered ; as necessary. ; Character class flag definitions - all in LH ch%msk==377000 ; Note sign bit not included; user can set. ch%ul== 200000 ; Uppercase Letter (A-Z) ch%ll== 100000 ; Lowercase Letter (a-z) ch%d== 40000 ; Digit (0-9) ch%pt== 20000 ; Printing (41-176; all but CTLs, SP, DEL) ch%wsp== 10000 ; Whitespace (SP, TAB) ch%fmt== 4000 ; ForMaT effector (^H, ^I, ^J, ^K, ^L, ^M) ch%lbr== 2000 ; Left BRacket (<[{ ch%rbr== 1000 ; Right BRacket }]>) ; Some useful combinations ch%l==ch%ul+ch%ll ; Letter (upper or lower case) ch%ld==ch%l+ch%d ; Letter or Digit ch%uld==ch%ul+ch%d ; Uppercase Letter or Digit ch%lld==ch%ll+ch%d ; Lowercase Letter or Digit ch%br==ch%lbr+ch%rbr ; Brackets ; CHTMAC - macro defining a character table with standard flags. ; Can be used as-is just by putting "chtmac" someplace, but ; also serves as a model for defining non-standard tables. define CHTMAC chrtab==. ; Addr of latest table. repeat 200,c.set \.rpcnt,0 ; Reserve 200 locs and set values to char only. chrgrp addl,.ascvl/A,.ascvl/Z,,ch%ul ; Add flag ch%ul to chars "A-"Z incl chrgrp addl,.ascvl/a,.ascvl/z,,ch%ll ; Add flag ch%ll to chars "a-"z chrgrp addl,.ascvl/0,.ascvl/9,,ch%d ; Add flag ch%d to chars "0-"9 chrgrp addl,41,176,,ch%pt ; Add flag ch%pt to chars 041-176 inclusive chrgrp addl,^I,," ",ch%wsp ; Add flag ch%wsp to chars ^I and 40 chrgrp addl,^H,^M,,ch%fmt ; Add flag ch%fmt to chars ^H-^M inclusive chrgrp addl,133,,"(<{",ch%lbr ; Add flag ch%lbr to 133 = [ and (,<,{. chrgrp addl,135,,"}>)",ch%rbr ; Add flag ch%rbr to 133 = ] and },>,). termin ; CHRGRP - Macro for easily setting ranges of chars in a table. ; Syntax is: ; chrgrp ,,,, ; Applies to specified chars according to . ; The range of chars to set can be specified in two ways; either ; or both can be used. ; * All chars from to INCLUSIVE. ; If is null, use only . ; If is null, use nothing. ; and must be expressions, not chars. ; * All chars in , which has "strung" syntax. ; If is null, use nothing. ; Applicable modes are: ; SET - like MOVE ; SETR - like HRR ; ADD - like TDO ; ADDL - like TLO define chrgrp mode,ch1,ch2,*str*,?val if1 .stop ifsn [ch1][]{ ifsn [ch2][] %%%nc==1+- .else %%%nc==1 %%%tlc==. loc chrtab+ repeat %%%nc,c.!mode \<+.rpcnt>,val loc %%%tlc } ifse [str][] .stop %%%tlc==. irpc c,,[str] loc chrtab+<.ascvl /c> c.!mode \<.ascvl /c>,val termin loc %%%tlc termin ; Define the s for CHRGRP. define c.set #chr#,?val termin define c.add #chr#,?val termin define c.addl #chr#,?val > termin define c.setr #chr#,?val &ch%!chr\val> termin