IMD 1.18: 7/12/2016 20:53:31 ee.y.c source  UUUUUU@@@@UUUUUUUUUUUUUUUUUUU UUUUUUUUUUUUUUUUUUUUUUUUUU +(C)ZILOG,INC.1981MCZ-2 CP/M BOOTSTRAP 820951  !96 !ut!ut!ut  u t !6u t6!ut!ut!Ou t\X COPYRIGHT (C) 1979, DIGITAL RESEARCH _͌> ͒> Ò> Ò͘~#͌ì _2<ܯ2 ݇!2:2a{_:ʖ:>Ľʖ:=2–!B!6#5ʖ:Ľ!ͬʧ )!F#xʺ~0wëw!" !~6ͽ:ý(!#͘*~ "޷"͌#>?͌͘ =_.:;<> Oޅo$>!Y2*O"ʉ@G:ʐ:wÖx2p0ʹ#*©6?ëw˜0ï#6 ¹.0#*6?w0#6 #6" #~?  xDIR ERA TYPESAVEREN USERO !yO#< Ty#O 3߯21y_͸2y2ͽ:ܷ˜1͘A͌>>͌92^ :¥.!_~#fow]!v"!çREAD ERRORçNO FILE^: ! ~ 3#0 Wx x ހ ނ G ~ # 3x~#B!Y~ɯ2:=!ý:=!:ý^T!~  6?#ˆ:`O> K{͘A͒>:͒͢>:͒͢xK > K > ͒x  ͢ØÆ^ BRͧ9!5‚#~Y‚#"T<ÆALL (Y/N)?^ Tʧ͘!6!~ڇ w4!Y~ʆ͌†t=ʆf ^ T 2o&)|+!<ͧÆNO SPACE^ :Ty!B*O=?_s#"^sG!~Ypsp2mÆÆf ͧÆFILE EXISTS _: É: :ʉ=2)ͽÉ T!@k!}|q=qf^!~2>`~22\!!B!~> >#0~O#Cx2͘1)ͽÂf zͧÆBAD LOADCOMf^: ! Â$$$ SUBO "C{2!"E9"1A22!ty)K!G_^#V*C~E ,&-AGMS!!ô!ô!Bdos Err On : $Bad Sector$Select$File R/O$:BA2!~6 O͐  :E B 2>: b# : y! 4 5~yy5 6yҐ^H@Oy H H: –ͬ  #H: !  Hù H H $O͐: 2 *CN# x: 2 p&x~+é72 H! >w_: ! 5ͤNkͱ¦ͱxʊ#Nx: ! 2 ͤ! 5™#wO~x½p Hy<< ʑ :!qMD#2E>! ^#V w#P:BO|^#V#"##"##"##"!O*!O*|!6ʝ6>*w#w*w#w'û*! J*""!N#F*^#V*~#foyx*{_zW+*yx#*DM*s#r*s#ryOxG*0MD!!N: EG>O: \S*C :qn& ^#V>O^"*}:*)=":O:o"*C *C!ͮ~2~2ͦ:2ͮ:O:w:w |g}o*#  ):BO!yoxg*:BO}!N#F "*#*s#r^ ~!J! J*:o$*C~i6iw**{#zr+s{ozg**͕** ,w͜͸Ͳ!!N#F$**O!~#:A#~$=2Ek͌::/GyO>2!q*C"͡ʔ*JҔ^:Oyʃ?|x | s-|N-# S:2E!~Яw>T D^6k-äPYy 5*{zBK5ڋ>*Cw~#+w#w+ɯ2E22i^ *C :~w~͔͔# #  w ~>2!E5T*C!"C"C!w# F! w͌x2͢*C ~<wʃG:!ʎì 4~ʶ¬:<ʶ$ʶïZͻx>2>2ͻ:!Z2:Eẅ́͊Ͳ>2>2T*CGͻ:ẅ́n>2;O ^DM;}H>"*C ::ddslO s#r:E͊:==»y==»*Ww#*"͸*:G#š"͸:!w4!iw:Z!E~=262*C!!~~#~O~G#n,-.‹! w! yG!x͢.:E<ʄ! q!pQ:E<. ʄ$.:E<ʄi6}2ExN! ~态O>G~G!~G} *C!r#r#r ^ͥ_y#x#{s+p+q-*C ͥ!!q#p#w*:BOYG}*MD "ã:!Bw!>2*C~=2u:B2~2wE:A*Cw>"!""2B!"!rQQQâ~?ͦ~?rQ*"CQ-Q͜QüQrQ$Q*):B"*)*)Q;*"E:;:A2AQÓQÜQ*C}/_|/*W}_*"}o|g":ʑ*C6:ʑw:2E**E}DQ>2*>Oa"'.3o?QüM222FFFWWWWi22FWQ MCZ-2 CP/M BIOS 82161 (C) ZILOG, INC. 19811!%2>211!: .!">2!"2!":O2222!C%!B:! >!J2(U!RW(y!Z(!yFˆ(  N(> ˎۆG(ۄ ۆG(ۄ ۆW(yӄ!b/w>ۆ>W !j0!r>!":2!y :>(o2))))?CCC> 2:?8[!ͷ>2>22>2:?8*ͷy2 >2:2*"K?":(I=2:! <*KB 0K?KB !hB *#" C22<22>*(<="!~6((:! *KB *KB($:!:2*"*":2*}o|g)[: (>2::2!:> >2:?ͷ:! ! 2"*"*!2*K "**:2*K!> >2*K! 2{ i` n`!!z~O< w! ~s1!U˿w{Ms1!4 T#4V(Nw++><4 D6+4 =6+4> 46+4F+~ +~#> < O !Q ~# 6+4> 6+4{M:@ (O ~#fo))MD))]T n f s#r~OW#!f""""!"t!k8!n8!]8!g8j͞yͼ(yͼ @!R(S/2:>2!  62! Fx/wp˗:2:W:! >>>>>>2!>2!2s_!qOyy( (q#p+ s#r<2 !5" ! !" : 2 :((: : O! ~( :(>7>~ G !"r>>կ2"> O(:(6 I>s1>2{MN#F#r(rH0X:rEhnEratr      ()23<=FGPQZ[de$%./89BCLMVW`a  !*+45>?HIRS\]fg &'01:;DENOXYbc"#,-67@AJKTU^_*+TU@A,-VWBC./XYDE01Z[FG 23\]HI 45^_ !JK 67`a"#LM89bc$%NO:;de&'PQ<=fg()RS>??h h @9& Zilog MCZ-2 CP/M Version 2.0 64k CP/M vers 2.2 Boot Error.     LGp,,<*7 ͣ,=-G~# "- *-͗,-x͗,G‰,&‰, "7͝ V- V- \-͗,C-d 1-k-d 1-͗,e-͝ ;ʍ--]5͗, >5͝ -]5]5 ʐ- ʐ-̈́5"9>5 >5> 4>5:9-*94.*9~-G+-~/_-~ .=G+~ ..-+<= .+.~>...?*9O #*96 2."9+D`E` Z.b8.,. .@@$@B B HH II$@DI ABI$"$H$H@$$I! H*  $H@@A I $D!!$I"BI"I"@$BIIH$$$$BBI$@BI!"$$A DI$@ A$@$$@H! "!$$" @B$!!!DH$$"H @@BHH  !$$A"D@ "A" "BHA " !$ D B I $ !$$ H@BD D$ HI DIA!$$$ $" "$D ! $"  $AB " BDD $$D!"DI$!$BH!"IB I$"D HD" " $"! @H !BI " I  $I$I$DI$ !I$@"$"$! $I$I$UUUUUUUP$I@@ II$ ! A D! DI"I I@$@"! D@DI"$@ @ !"  H I$$ H!@@ H $$  @@$@ @01AB7C8FE20DA0903C8FE3DC8FE5FC8FE31 :100440002EC8FE3AC8FE3BC8FE3CC8FE3EC8C91ACC :10045000B7C8FE20C013C34F03856FD024C93E0028 : >#0~O#Cx2͘1)ͽÂf zͧÆBAD LOADCOMf^: ! Â$$$ SUB"C {2!"E 9" 1A 22!ty)K!G_^#V*C   ~E , &-AGMS  !!ô!ô!Bdos Err On : $Bad Sector$Select$File R/O$ :B A2 ! ~6  O͐  : E  B 2 >: b # : y! 4 5~yy 5 6y Ґ ^H @Oy H  H : – ͬ   #H : !  H ù  H  H $O͐ : 2 *C N#  x : 2 p & x ~+é 7 2  H ! >w _ : ! 5ͤ N k ͱ ¦ ͱ xʊ #N x : ! 2 ͤ ! 5™ #wO ~x½  p H    y< < ʑ  : !qMD # 2E > ! ^#V w#P :B O|^#V#"##"##"##"!O *!O *|!6ʝ 6>*w#w*w#w'û *! J * ""!N#F*^#V*~#foyx *{_zW+ * yx # *DM*s#r*s#ryOxG*0MD!!N: E G>O: \ S *C  :q n& ^#V> O^ "*}:*)= ":O:o"*C  *C !ͮ ~2~2ͦ :2ͮ : O:w:w |g}o *# ) :B O! yoxg*:B O }!N#F "*#*s#r^  ~!J  ! J *:o$*C ~i 6i w**{#z r+s{ozg**͕ **  , w͜ ͸ Ͳ ! !N#F$**O !~#:A #~$=2E k͌ : :/GyO>2!q*C " ͡  -'   -@ ͦ ~^ *C  O x ! N!Fwyxʋ>ڋ>*C w~#+w#w+ɯ2E 22 i  ^ *C :~w~͔͔# #  w ~>2!E 5T *C !"C  "C !w# F! w͌ x 2͢ *C  ~<wʃG:!ʎì 4~ʶ ¬:<ʶ$ ʶïZͻ   x >2>2ͻ :!Z2:E w ̈́ ͊ Ͳ  >2>2T *C G ͻ : w ̈́ n> 2;O ^ DM;}H> "*C  ::dd slO s#r:E ͊ :==»y==»*Ww# *" ͸ *:G#š" ͸ :!w4!i w: Z!E ~=26 2*C !!~~#~O~G#n,-.‹! w! yG!x͢.:E <ʄ! q!pQ:E <. ʄ$.:E <ʄ i 6}2E x N! ~态O>G~G!~G} *C !r#r#r ^ ͥ_y#x#{s+p+q-*C  ͥ!!q#p#w*:B O Y G } PIP COM:ZED1  EE M ZED2 T ZED22 ZED22 XZED3  RJ S !:$: $͈Ͳ!N6' :!Cwͯ !6:^͢c!6{:/>!/H{ͯ :<2Š ::=HҮͯ !6:Ҿ:2 !6::/H͈;!6:> !/>:H:H"!6!4:_jYO jM*"S*" 3@bl*M1͓!""7 *M^͆ \͔!":͎H*#"ͧÝ/ :>͛9ͯ .*#":_!CDECL *M:>!(:=2%> >>!F!5+N! ~2!4<2T>>!b}*bMͭz:b2!b6:<2é>!`ҥ*`MͭҞ!`6!6> :é:(!q:!wO! ~2*& :w>!:!4!6>:N<2N!RJ X "EEX M #$HIST %S ^&v{|}~ZRAM !3DEY2 456789:;Y2 p<=>?@ABY M CHHͯ :^!w:<2:0}:@E}:!S!W6: z!]6:cm!c6:_z!_6l ::,: HHҰͯ : 2ó:E:1:2v!q!*8!*6: >' !'6!36' :1/!aE*#">z?C9IͲÁ.!6> !ڇ*&' ~2 ʀ: y.*M!4Q>!қ:=2á:2:Ҭ\>!ҿ:=2K:2K!:!:K\: \!p+q͈*> *N& N2 !p+q!6!6+6 !6: S: M!6g8:N2M*M8p!6!6!6>!ڕ*&P 6!4z!6!6#6#6!6*M8:ھ:*͇g2ê::¿::,͡A<2O>ZBAS FGHIJKLMZBAS ͦ!q:_  !p+q.*   !q*&!p+q*2!p+q*2!p+q*22!p+q*!p+q*!p+q*!p+q*2!p+q*DM!  ::=H-\:N2O_og_{ozg^#V))) _{ozg^#V) d^#V|g}o n_{ozgO{ozgi`N#Fogo&og H ©=¨*M8):[ͱ!N5!6ñ:5!6#6>!ڰ!6:<2O>/:!O!T *M͡H~K:¡!6[–ͱ!N5:2:2!4=:[¼ͱ4:!6:.2O8: :* ͇gZASM Z z{|}~ZASM Z ZXX Z ZXX Z ZXX Z DXMETA Z EE-BTOA SUBEECONFIG !'tz!p+q* !q*& *M *M !p+q*!!p+q*"!p+q*$!6  !kp+q*j> >ڪ Þ !qp+q/ *pDM9: :M2r:N!r !:r *r& N!r4 !6::[ ͱ!N5!6:%:<2*6 * 6å!q!6> !d*&I :]>!4A>:<2O* :w:?†!6!q!6?!:ҠgÐ!q*&*~!6:22: :]Hں:A2O>: 2ͯ EE ;SUBMIT COM E COM8Y-BTOA SUBZED1 iY Y pZSUB ͔: :ͳ.!ws+p+q+p+q:w=2wN *s*u w*s#"s*u#"u' !"*M^7 !x6:!xھ **DM͆ 2yʭ :yʗ ͯ *"*6:2x÷ *"!x4d !"/ !j}=2| !"*KM^'_ !z6:|!z1 *÷:S:QHI:N<22: H@"2Í202O> c!6Í202O> ڍ*&O*& !sc*&P :w:·>!ұͯ :22:_!6=!6>'!E!4!p+q*0 !C1-ATOB SUB(C2-ATOB SUB)C1-BTOA SUB*CBAS +C2-BTOA SUB,CDATA ./YLINK MXXC a  "}*}DM͆ ' ͯ *"!z4 :e !"͆ !z6:|!z '? 2*H#"H!{6:{ր!Ң *{& :{4 2!{4m *":ڹ ͯ !z4I '2!"!q: !4>!S :S! :2*M(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)(INP:/OUT:SPACE)r+s+p+q*~$7*>*>H&>*#"*#"> 2:R͎:!6!6=2:ʙ!6:“H9Ž>!6-e!6ͻ2=2ʺ-é:>>"ͻ2:!!5ͻ2ͬ!\CBUG PREPROS ZCGPUTS MACDEFS CDECL CFLOAT CSUB XSUB S! ^#V͎ * :w*#" = = = = = ͯ  *M !6q  !6q  !6q  *& !6à  !6 à  !60à  *& !6  !6  !6  *& . 1 4 7 : = F P [ f q  ... FULL SCREEN EDITOR MAXNCOL: EQU 128 ...max # cols. NROWS: EQU 24 ...no. of rows on screen NCOLS: EQU 80 ...no. of columns on screen ...DEFRL: EQU 0200 ...rounds len. to this when writing out files (tmp) MAXFNML: EQU 32 ...max. file name len. FNF_ COPYRIGHT (C) 1979, DIGITAL RESEARCH, PIP VERS 1.5$$$ SUB =.:,<> _[]INPIRDPTRUR1UR2RDROUTLPTUL1PRNLSTPTPUP1UP2PUNTTYCRTUC1CONNULEOFDISK READ ERROR$DISK WRITE ERROR$VERIFY ERROR$NOT A CHARACTER SINK$READER STOPPING $NOT A CHARACTER SOURCE$-:>>!p+q:,!6*DM9:<!6:z 2W!6D*&L :w:<2Ov*:>=20O> ڒ:0:AO>Ҥ::A }}Hͬ!wͻO`idͻV[2O>2:!X!6:!CGPUTS *CSUB rCBUG k    C M  CBAS 6CDECL  !CX "#$%&'()CX *+,-./01 :2!q: " *M n :c4 *M n :2!c:Q !c:2: !:cw>!n !5 Y : { !6!q:!lwҙ  â :0O !q:O| :O| !6:]2l:o'2o:n'2n:m'2m*mMͣ *nMͣ *oMͣ :]ERR: EQU 0C7 ...error code for file not found EOFCH: EQU 0FF ...end of file char. (internal & RIO) EOFX: EQU 01A ...external eof char. RTL: EQU 15 ...dist. from right margin to start cmd. line messages CR: EQU 0D ...carriage return TAB: EQU 9 ...tab ABORTED$BAD PARAMETER$INVALID USER NUMBER$RECORD TOO LONG$INVALID DIGIT$END OF FILE, CTL-Z?$CHECKSUM ERROR$CORRECT ERROR, TYPE RETURN OR CTL-Z$INVALID FORMAT$HEX$$$$NO DIRECTORY SPACE$NO FILE$COM$START NOT FOUND$QUIT NOT FOUND$CANNOT CLOSE DESTINATION FILE:=O!L NE!4 E E:/.*&L 6$L9k9.Xͯ *KM^020 :020:121'ͳ':²ͯ !G6!"!"7 *M^n/ :a/:H!6:ͯ !&6CX  2C 3456789:C ;<=>?@ABC TCCGSUB DEFGHIjkBASICIO C JJSTUVHOJOB M OHOJOB 2-012:   *}2D" * * *&"!q:UY: Y:ҩ: ʩ:_2ʘ:€!6<:<2!ژ!6 >!]Ҥ; !6:Q::H: !6*M : !6!q:a/>z!LF: EQU 0A ...line feed BKSP: EQU 8 ...backspace (cursor left) ESC: EQU 01B ...escape RUB: EQU 07F ...used for deleting current character CR2: EQU 18 ...ctrl R; used to stand for CR in LOCATE string SHOWCH: EQU 023 ...'#': char. printed out in place $DESTINATION IS R/O, DELETE (Y/N)?$**NOT DELETED**$$$$$$$NOT FOUND$COPYING -$REQUIRES CP/M 2.0 OR NEWER FOR OPERATION.$UNRECOGNIZED DESTINATION$CANNOT WRITE$INVALID PIP FORMAT$CANNOT READ$INVALID SEPARATOR$1 :2L> ̈́M9 2*">!b!ͯ >!`0ͯ !q:E:24J!46*}a!44EJ *KM^'́:‚ͯ !36'n::0:f9OY#9.3'ͳ.:020' 'ͳ'7 6'HOJOB C 8KLMNCMAIN aPQX COMRS ^WXYZ[\CGSUB 4lmnEE-ATOB SUBoSYS COM uCOMPARE S wx/H:_2:!q:A/>Z!/H8: 2::=O>m:W!Q} Hmd>9>!6:2*M!E ^#V͎ڗO **~2*#"m2m͖ 2m!6m!6m!6 m2mof special chars. UPCASE: EQU 0DF ...'AND' with lower case to get uppercase ...screen specific codes: CLRI2: EQU 0C ...clear screen (Infoton 200) CLRV2: EQU 'v' ...clear screen (Visual 200); see CLRSCR routine below ERSLI2: EQU 0B ...erase line (Infoto221@:2!o6+6+6!6#6!6#6:G*o .!N6:^*M^!K6!6!6+6' :$::=2K  :ʤ\:ҷ\x'Ͳ:!\͢  :͈'! !j>A+!s!"@͓1!"<**"͓n "Dn"":!Q2҂:X!Wғä:ڤ*MEÓ:ұ@@:O2Mc;!6#6>!)*&P ~"::H:HC1-ATOB SUBpEECONFIGS 1C2-ATOB SUBqG COMrsCOMPARE yCODEGEN CODEGEN CODEGEN ͯ m!62m!62m!62m!62m'2:2:TҒ:2!6*ME:2::Ҳ:<22ý: 2:} >ͯ :i:2:d*M:[  n 200) ERSLV2: EQU 't' ...erase line (Visual 200); see ERASL routine below CRSXYI2: EQU 23 ...cursor pos. I200 (next 2 bytes are X & Y coordinates+32) CRSYXV2: EQU 'Y' ...ditto Visual 200 but Y,X (+32); see POSCRS routine below CSADROI2: EQU 0A0 ...curth of STR2 vs. STR1 SFLFLG: BYTE 0 ...if set=1, indicates screen full TAGFLG: BYTE 0 ...if set=1, indicates a tag in place; =2, tag 2 in place BYTE 0 TGPOS: ...the following 3 words must be in order: TG1POS: WORD EBUF0 ...pos. of 1st tag ("from") TG2PO1:=RL1; JR ENDRX end ...if at CR (col.->R.B) if RL0=TAB then TABPOS() ...if at tab until RL1:+1>LCOL; ...check if past end of row ENDRX: RL1:=0; RET FNDCOL: ...enter with R.DE in buffer at 1st char. in row; R.C=cursor col. ...return with R.DE at c h E!ͽP!@ T8и9"! !ν!Bء1 D MaСe!B 0`-(D硑_6%e!Bء7 pcq4qgܠ× AЯACs ts`ent seg->R8 R9:=^CMDBUF->R13; RET ...RR8,R13=^CMDBUF EDIT0: ...move system cmd buffer to CMDBUF (RR12 pts. to del. after filename): LDL RR10,RR12 PTMYBUF() ...^CMDBUF->RR8->R13 R1:=MAXNCOL-RTL repeat RL0:=@RR10'->@RR8' until RL0=';' or RL0=CR or R1sor addr offset (+ X,Y order) for I200 CSADROV2: EQU 020 ...ditto V200 INSLV2: EQU 'L' ...insert line (Visual 200); see INSLIN routine below I200: EQU 0 ...code for Infoton 200 CRT type V200: EQU 1 ...code for Visual 200 CRT type ...system equates: STDS: WORD EBUF0 ...pos. of 2nd tag ("to") TG3POS: WORD EBUF0 ...pos. of invisible tag 3 EOFFLG: BYTE 0 ...set<>0 if "EOF" on current screen ESCFLG: BYTE 0 ...set<>0 if escape during WAITCH proc. BLCMRF: BYTE 0 ...set<>0 if something on right part cmd. lhar. corres. to cursor pos.; R.C=its col. no. RH1:=RL1; RL1:=0 ...R.B saves cursor col. FCLUP: RH1==RL1; RET Z ...go thru row until R.C=cursor col. RL0:=@R7==CR; RET Z ...if at CR RL0==EOFCH; RET Z ...if at EOF if RL0=TAB then begin ...if at tab +0A ...addr. here=beg.+0C EEX0: WORD EEX ...addr. of EEX if defined; else =odd (1) ECODE0: WORD ECODE ...addr. of ECODE if defined; else =odd (1) ...next 24 bytes for reference by extensions (here ^EBUF=E0+010) EBUF: WORD EBUF0 ...start of edit buffer (:-1 zero; R9:-1; B.CR->@RR8 LDRB RH1,EFLG ...RH1=0 if need to load file JR EDIT1A ... EDIT1: ...from here, always ask for file PTMYBUF() ...^CMDBUF->RR8->R13 LDB @RR8,#CR RH1:=0 EDIT1A: LDL RR4,RR14 R9:=^MYSP; LDL RR14,RR8 ...set SP (must do seg'IN: EQU 0 ...LU# for std. input (usually console) STDOUT: EQU 1 ...LU# for std. output (usually console) CONLU: EQU 2 ...LU# should always be console RD: EQU 2 ...read sys cmd WRT: EQU 3 ...write sys cmd SC_SEEK: EQU 5 ...system call to seek to a filine SCLFLG: BYTE 0 ...if<>0, CONOUT allows this many scrolls QSEQP: WORD 0 ...if<>0, pts. into QUITSEQ (used by GETCHR) LCMDBUF: EQU MAXNCOL-RTL LSTRBUF: EQU MAXNCOL-RTL-2 CMDBUF: BYTE 0[LCMDBUF] ...command line buffer STRBUF: BYTE 0[LSTRBUF] ...strin RL3:=RL1; TABPOS(); RL0:=RL1; RL1:=RL3 ...1 before next tab pos->R.A RL0==RH1; RET NC ...if cursor within tab area, R.C=col. of tab char. RL1:=RL0 ...R.C=1 before next tab pos. end R7:+1; RL1:+1 JR FCLUP CHRPOS: ...enter with R.DE in buffer;must have 1 free space before) ENDDAT: WORD EBUF0 ...pos. in buffer of 'FF' at end of file ENDBUF: WORD EBUF9 ...end of edit buffer (^ENDBUF=beg.+014) /NONSEG ...the following 5 jps are for use with extensions: JP LOCSTR ...=beg+016 JP NEWSTR ...=beg+0d) R3:=flag; RES R3,15; R3->flag /NONSEG LDL SYSSP,RR4 ...save system SP RH1==0; JR NZ,EDIT2 ...if reentry, don't read in file again CALL CRTTYP ...determine CRT type & print version msg. R7:=R13 ...^buff with cmd SPC(); if RL0=CR then NAMEQ() .e pos. SC_FSTAT: EQU 7 ...system call to get file statistics /SEG E0: EDIT0(); RET ...normal entry or reentry E1: PROC; EDIT1(); RET ...enter @beg.+4 if not called from system with filename (asks for it) WORD SCRVEC ...@beg.+8 WORD KEYVEC ...@beg.g buffer XCMBUF: BYTE 0[5] ...buffer for "X" cmd. SAVCHBF: BYTE 0[3] ...used by PUTEOFSQ,RESEOFCH STK: WORD 0[070] MYSP: CMDTBC: ...table of char. cmds. for moving cursor, entering a mode, or ... executing cmd. line & address to go to BYTE 19 'E' 'I' ret. col. of char. at BUFPOS->R.C ...no. of rows to BUFPOS (past first)->R.B ...ret. Z=0 if R.B gets bigger than no. rows that fit on scr., else Z=1 LINBEG(); R1:=0 ...RL1=RH1=0 ...go to beg. of line; 0->row count CHPLUP: R7==BUFPOS; RET UGE ...chec1A JP LINBEG ...=beg+01E JP NXTLIN ...=beg+022 JP NUMBER ...=beg+026 E_VERS: BYTE 0A ...@beg.+02A; inc. when E version changed EFLG: BYTE 0 ...must init. be 0, set=1 once file read in CRT: BYTE 0FF ...if<>0FF, holds CRT type (0=Infoton 200, 1=Visual..if filename not given, ask for it CPB @R7,#CR; JR Z,EDITX ...if still no name, ret. GETFNM(^FILNM) ...get filename to open supp. vector ... CKPARM() GETCINIT() ... if CMDSW<>0 then CFINIT() ...if using cmd. file, open it, set ptrs. READIT()->R5; J...Editor make file ...to use, /DO E.M, type in image statement as written out when done ORG 0 *DO ZED1 *DO ZED2 *DO ZED22 ...extensions go here if assembling with editor (rather than using E.X.M) *DO ZED3 EBUF0: ADDR ENDROM&0FF00+0100 ...start of edit b 'R' 'X' CMDTBC2: BYTE '4' '6' '8' '2' '7' '1' TAB '_' ...this line set from KEYVEC BYTE BKSP ' ' '-' LF CR CR2 CR WORD CRSCR CRSCR CRSCR CRSDN CRSUP CRSRT CRSLT WORD CRSLTB CRSTAB CRSBTL CRSHM CRSDN CRSUP CRSRT CRSLT WORD XEQ REPLCE INSERT ENTER CMDTk if to BUFPOS (or if DE>BUFPOS) if RL0:=@R7=CR then RL1:=LCOL ...if at CR if RL0=TAB then TABPOS() ...if at tab R7:+1; RL1:+1 RL0:=RL1-NCOL; JR C,CHPLUP ...check if goes to next row RL1:=RL0; RH1:+1; RL0:=NROW-2; RL0==RH1; RET C ...R.B>no. rows/s 200) DUNFLG: BYTE 0 ...set by QUIT to 1 (or 2 if not to write file out) LROW: BYTE NROWS-1 ...set from NROW LCOL: BYTE NCOLS-1 ...set from NCOL SYSSP: WORD 0 0 ...save calling SP ...CMDSW: BYTE 0 ...if =0, cmds. from cons.; =1, cmds. from cmd file .... Full Screen Editor - Part 2 EDIT: DUNFLG:=0 ...zero DUNFLG; will be set to 1 when done CLRSCR(); PUT1(RL0:='T') ...clear screen; print 'T' on cmd. line RL0:->@^CMDBUF; R3:+1; LDB @R3,#CR ...'T'->cmd. buff. TOP() ...print 1st part of file repeauffer (1 free space before) EBUF9: ADDR EBUF0+((0F900-EBUF0)/0200*0200) ...end of buffer /MAP UNDEF /WRITE "Type in:" /WRITE "/IMAGE EE ",E0," ",ENDE-1," E=",E0," T=N" ORG 04E00 /SEG  B2: ...table of 1st char. of cmds. that go on cmd. line & addr. to go to DEFT '.;KPGWSBMOCLDFQTNJJ' WORD JOIN JOIN N T QUIT FORWRD DELETE LOCATE C OFF M BOTTOM SHOW WORD WAIT G PREV KOMPAR NULL EXTN KEYVEC: ...def'n of keys for cursor move cmds + poss.cr. JR CHPLUP FNDCH0: R7:=BUFP0 FNDCHR: ...enter with DE=next 1st scr. char.; set BUFP0=DE ...if char. at BUFPOS on screen, its row->CRSROW, col.->R.C, BUFPOS->DE ... Z=1; else Z=0 R7:->BUFP0; CHRPOS(); RET NZ RH1:+1->CRSROW; R0==R0; RET FNDCRR: RL0..OLDFLG: BYTE 0 ...if<>0, make .OLD file ...SVENDB: WORD 0 ...save orig. ENDBUF when allocate sp. for cmd file buff. ...CMFPOS: WORD 0 ...pos. in cmd. file buffer for next char. to be gotten BUFP0: WORD EBUF0 ...position in buffer corresponding to 1stt GETCHR() ...get a character from keybd (or cmd file) ->RL0 RL0:->RL7 if TAGFLG=0 then BLCMR() ...if no tags, blank right part cmd. line if BLCMRF<>2 then CALL TAGSHW_ ...in case tags & tag ind. erased CMD(RL0:=RL7; ^CMDTBC) ...look forEIRX468271 _ -  ,||n,|d@8.;KPGWSBMOCLDFQTNJJ8>0 &J D 468271 _ PFILE TOO BIG NOT ASCII  redef'n of RUBOUT ...left,right,up,down,home,bottom corner,tab,back tab BYTE '4' '6' '8' '2' '7' '1' TAB '_' LKEYVEC: EQU $-KEYVEC RUBOUT: BYTE RUB SCRVEC: ...screen function codes + screen size CSADRO: BYTE CSADROI2 ...cursor addr offset + bit 7=1 if:=ROWNO; JR FNDCR2 ...use ROWNO for FNDCR row ... FNDCR: ...enter with R7 at char. in buffer; RL1 corres. col. ...find CR ending curr. line: buffer pos.->R7; row->CRROW0; col.->RH1 RL0:=CRSROW FNDCR2: RL0:->CRROW0 FCRLUP: ENDROW(); R7:-1; CPB @R7,#CR; R printed char. BUFPOS: WORD EBUF0 ...pos. in buffer for action LSTROW: BYTE 0 ...row no. of last row printed out ROWNO: BYTE 1 ...row no. CRSROW: BYTE 0 ...row cursor is in (0..LROW) CRSCOL: BYTE 0 ...column cursor is in (0..LCOL) EIRFLG: BYTE 'E' .. cursor move or mode enter cmds. if not zero then FILCML() ...if not found, start filling cmd. line until DUNFLG<>0; RET FNDPOS: ...char. in buffer corresponding to cursor location->R.DE->BUFPOS ...sets ROWNO=CRSROW, R.C=col. of char. R7:=BUFP0; RNAME? ERROR ERROR NOTFOUND QU N NO ROOMHIT KEYNO CHG ENTER INSERT REPLACE ??? TAG 1 TAG 2 EOF! \!q . ;;   .0 ! "}2?}:]0$_|  % q /!@ߗ1(a4K X,Y not Y,X LEADIN: BYTE 0 ...lead-in char (e.g. ESC), 0 if none ...in following, bit 7=1 =>requires lead-in CLRSCRN: BYTE CLRI2 ...clear screen CLRLIN: BYTE ERSLI2 ...clear line (or to end of line) ADRCRS: BYTE CRSXYI2 ...addr cursor INSLN: BYTE 0 ET Z ...ENDROW sets RH1 R7:+1; CRROW0:+1; JR FCRLUP NXTLIN: ...enter with R.DE in buffer; go to beg. of next line (->R.DE) RL0:=CR; R1:=0; CPIRB RL0,@R7,R1,EQ; RET TABPOS: ...enter with R.C=col. of tab; return with R.C 1 before next tab pos. RL1:|7; .set='E', 'I', or 'R' for enter, insert, or replace mode FULFLG: BYTE 0 ...set=1 when buffer full CRROW0: BYTE 0 ...row of CR before ins./repl. SHOWCR: BYTE 0 ...if not 0, char. printed out at CR pos. SHOWTB: BYTE ' ' ...if set='~', print '~' at 1st poL1:=0 ...start col. 0, row 1 RL0:=1->@^ROWNO while RL0:=CRSROW<>@R3 do begin ...check if cursor past current row CPB @R7,#EOFCH; RET Z ...needed by "NEXT" PUSH R3; ENDROW() ...go to beg. of next row POP R3; INCB @R3 end FNDCOL(RL1:=CRSCOL)0oL+۠L-xF GType 'X' to reenter\nT0}2?}:Na 50 5 a0 5  `:`;`ƕ`!4MZMZ DMZaZ 8iZ``...insert line or 0 if don't have LSCRVEC: EQU $-SCRVEC NROW: BYTE NROWS ...no. of rows on screen NCOL: BYTE NCOLS ...no. of columns on screen FILNM: BYTE 0[MAXFNML+1] TOOBIG: DEFM 'FILE TOO BIG'; BYTE CR 0 ...LF 0 NOTASC: DEFM 'NOT ASCII'; BYTE CR 0 TRET FNDPSB: ...do FNDPOS + PRTB FNDPOS() PRTB: ...set DE=1st char. & ROWNO=1st row of line with char. at BUFPOS R7:=BUFPOS; CHRPOS(); RL0:=CRSROW-RH1->ROWNO; LINBEG(); RET PKLROW: RL0:=LROW ...pick last row PIKROW: ...enter with DE at beg. of line, R.s. in tab LCMCOL: BYTE 0 ...last col. except CR in cmd. buffer or "X" cmd. buffer CBUFPS: WORD CMDBUF ...command buffer position NUM1: WORD 0 ...stores no. from cmd. STR2: WORD STRBUF ...pos. start of where 2nd string stored NCPERL: BYTE 0 ...if <>'*' ...find char. & col. of char. corres. to cursor col. R7:->BUFPOS; RET FNDPS0: ...do FNDPOS + LINBEG FNDPOS() LINBEG: ...enter with R7 in buffer; return beginning pos. current line->R7 R7:-1; R1:=0; RL0:=CR; CPDRB RL0,@R7,R1,EQ; R7:+2; RET ENDROW: 7:``ES0RS!Q!@ ʞ6a0C!1ca!CߡcA   8{0! !\2u!p!Bs .8! ЕC!5U 1&70P!P!@ XNMQ: DEFM 'NAME?'; BYTE CR 0 ...LF 0 TXERR1: DEFM 'ERROR '; BYTE 0 TXERR2: DEFM ' ERROR' TXNOT: DEFM ' NOT' TXFND: DEFM 'FOUND ' ...TXTQUN: QUITSEQ: BYTE ESC ESC; DEFM 'QU N'; BYTE CR TXTBL7: DEFM ' ' ...7 spaces TXTNRM: DEFM 'NO ROOM' TXTHTKA=desired row for line to start ...adjust the row up if necs. to start scr. with beg. of a line ...note: changes BUFPOS ...set up for printing screen: ... DE at beg. 1st scr. line; CRSROW=row with orig. line RL0:->CRSROW-1->ROWNO repeat R7==EBUF; , 1 chg. per line; else chg. all CHGALL: BYTE 0 ...set='*' when looking for changes on all lines CHGFLG: BYTE 0 ...0=no changes; 1=at least 1 change CHLFLG: BYTE 0 ...0=no changes on line; 1=at least 1 chg. on line DIF: BYTE 0 ...if pos., diff. in leng...enter with R.DE in buffer & R.C at corresponding pos. in row ...returns R.DE at 1st char. in next row; R.C=0 ...if row ends with CR, its col.->R.B ENRLUP: repeat RL0:=@R7; R7:+1 RL0==0; JR Z,ENRLUP ...if at null char. if RL0=CR then begin RH0 /6c(7"aCs!VcACcaq!BؓcA T !duuaH!wCs  !! !`U"C8s0!ԡ9!ͽQ!@ء:  ~ u!C.~A: DEFM 'HIT KEY' TXTNCH: DEFM 'NO CHG ' TXTENT: DEFM ' ENTER ' TXTINS: DEFM 'INSERT ' TXTRPL: DEFM 'REPLACE' TXTQST: DEFM ' ??? ' TXTTG1: DEFM ' TAG 1 ' TXTTG2: DEFM ' TAG 2 ' TXTEOF: DEFM 'EOF' ORG $+1&0FFFE /SEG PTMYBUF: CALR $+2; POPL RR8 ...curr JR Z,ADJROW ...chk if at beg. of file R7:-1->BUFPOS; CHRPOS() ...no. rows prev. line-1->RH1 if not zero or begin RH1:+1; RL0:=ROWNO-RH1 end CRSROW ...a1 ... while RH6:-1 not zero do INSLIN() ... R7:=BUFP0; ROWNO:=1; RL1:=0; PRLIN() ... POP R0; RH0:->flag; if not zero then CRSBTL() ... end else ... BAK1(1) ... endif end if CRSROW<>1 then CRSROW:-1 ...move cursor up if not top line  ...shift file back over nulls FULFLG:=0 BLCMR(); RET ...blank out right part of cmd. line; ret. cursor INNULS: ...expand line, inserting n null chars. in buffer (updating ENDDAT) ...n=lesser of 128 or available space (returned in R1) ...enter with  string in text; Z=1 if found CPILUP: POP R3; POP R7; POP R1 CPSIR0: RL0:=@R7[1]; CPIRB RL0,@R3,R1,EQ; RL0:=@R7; JR PE,CPIX ...1st character if RL0:-1 not zero then begin PUSH R1; PUSH R7; PUSH R3 RL0:->RH1; R7:+1 repeat R7:+1; RL0:=@R7==@R...ZED22: ENTER: ...enter "enter" mode (inserts CR after present pos.) TAGFLG==0; RET NZ R7:=ENDDAT+1 if R7=ENDBUF then begin NOROOM(); RET end ...if no room in buffer, write "NO ROOM" on cmd. line EIRFLG:='E' PRCMR1(^TXTENT) ...print 'ENTER' on djust cursor row RET end RL0:->ROWNO; RH0:=flag; PUSH R0; LINBEG(); POP R0; RH0:->flag until zero; ...go back till beg. of line at 1st scr. pos. RET SHFTBK: ...shift file starting at R.DE back R.BC places; update ENDDAT R1==0; RET Z PUSH RRETCRS(); RET CRSHM: ...move cursor home (row 1, col. 0) CRSCOL:=0; CRSROW:=1 RETCRS(); RET CRSBTL: ...move cursor to bottom left corner of screen CRSCOL:=0; RL0:=LSTROW->CRSROW; RETCRS(); RET CRSTAB: ...move cursor to next tab pos. RL1:=CRSCOL; TABR7->buffer loc. of char. to insert nulls before RL0:=128 INNLS2: ...supply R.A when enter here R3:=ENDBUF-ENDDAT-1; RL1:=RL0; RH1:=0 ...avail. space in buffer->R3; RL0->R1 if R3CRSCOL ...find pos. in buffer; adjust CRSCOL if RL1<>0 then begin CPB @R7,#CR; JR Z,EIR ...jump if at CR but not 1st col. end RETCRS() ...pos. cursor right at char. INNULS() ...insert nulls befor7; R7:-R1 R3:=ENDDAT-R1->ENDDAT R1:=R3-R7+1; POP R3 LDIRB @R7,@R3,R1; RET ...shift file back SHFTFD: ...shift file starting at R.DE forward R.BC places; update ENDDAT ...return R.HL at 1st opened-up spot R3:=R7 R1==0; RET Z R3:=ENDDAT; PUSH R3; PUPOS(); RL1:+1 ...find next tab pos. if RL1>=NCOL then begin ...check if goes to new row RL1:=0; RL0:=CRSROW==LSTROW; RET Z ...check if on last row CRSROW:+1 end RL1:->CRSCOL; RETCRS(); RET ...move cursor CRSLTB: ...move cursor left to tab pos:=0 ...reset flag if R1=0 then begin FULFLG:+1; RET end ...set flag for buf. full PUSH R1; SHFTFD() ...shift file past R.DE fwd. to make room for nulls LDB @R3,#0; R3->R7; R7:+1 ...R3 pts. to 1st opened-up space R1:=@R15-1 if R1<>0 then LDIRB @R7, if RL0:=CRSCOL+1=NCOL then begin ...check if at right margin RL0:=@^CRSROW==LSTROW; RET Z ...check if on last row INCB @R3; RL0:=0 end RL0:->CRSCOL; RETCRS(); RET ...move cursor right CRSLT: ...move cursor 1 space to left (with wrap-around) e BUFPOS R3:=BUFPOS+R1-1; LDB @R3,#CR ...replace last null with CR PRTB(); RL1:=0; CRROW0:=CRSROW ...get R7,ROWNO,CRROW0 if CRSCOL=0 then begin CRROW0:-1; PRNEW_() ...since CRROW0=*-1, will move rem. text down end else begin PRSCR() end ... PSH R1; R1:=R3-R7+1 POP R3; POP R7; R3:+R7->ENDDAT; R3<->R7 ...ENDDAT+n->ENDDAT->DE LDDRB @R7,@R3,R1; R3:+1; RET ...shift SHFIFR: ...do SHFTFD except if no room do NOROOM() if W.ENDBUF-ENDDAT-R1<=zero then begin NOROOM(); RESFLG Z; RET ...print "N. if RL0:=CRSCOL=0 then begin ...check if in col. 0 CRSROW==1; RET Z ...ret. if in 1st row CRSROW:-1; RL0:=NCOL end RL0:-1&0F8->CRSCOL RETCRS(); RET ...move cursor 0 CRSROW==1; RET Z ...ret. if in 1st row CRSROW:-1; RL0:=NCOL end RL@R3,R1 ...fill opened-up space with 0's POP R1; RET DELCHR: ...if R.A=BKSP: delete char. before BUFPOS; if replace mode just bksp. ...if R.A=RUBOUT: delete char. at BUFPOS, but not CR ...come here with HL=BUFPOS if RL0=RUBOUT then begin CPB @R3,#Cif RL0:=CRSCOL=0 then begin ...check if at 1st col. RL0:=@^CRSROW-1; RET Z ...check if on 1st printed row DECB @R3; RL0:=NCOL end RL0:-1->CRSCOL; RETCRS(); RET ...move cursor CRSCR: ...move cursor to beginning of next row CRSCOL:=0; RETCRS() RNWFB() JR EIRLUP ...print (shifts following lines down) INSERT: ...enter insert mode RL0:='I' ^TXTINS; JR IR ...pt. to text 'INSERT' REPLCE: ...enter replace mode RL0:='R' ^TXTRPL ...pt. to text 'REPLACE' IR: RL0:->EIRFLG TAGFLG==0; RET NZ PRCO ROOM"; set Z=0 end SHFTFD(); R0==R0; RET ...do SHFTFD; set Z=1 GETSTR: ...enter R.DE in cmd. buffer at delimiter before a string ...R.HL->beginning of where DEFT-like string should go (saved) ...returns Z=1 if string ends with orig. delim. (not CR)0:-1&0F8->CRSCOL RETCRS(); RET ...move cursor ile) ->RL0 RL0:->RL7 if TAGFLG=0 then BLCMR() ...if no tags, blank right part cmd. line if BLCMRF<>2 then CALL TAGSHW_ ...in case tags & tag ind. erased CMD(RL0:=RL7; ^CMDTBC) ...look forR; RET Z ...don't do if at CR RL0:=EIRFLG=='E'; RET Z ...don't do if in enter mode R3->R7; R1:=0 if RL0='R' then begin ...if replace mode TESTB @R3; RET Z ...if at null PUSH R3 while RL0:=@(R3:+1)<>0 and RL0<>CR do R1:+1 ...no...move cursor to beg. of row ... CRSDN: ...move cursor down 1 space (but not past EOF) if RL0:=LSTROW=CRSROW then begin ...test if on last row EOFFLG==0; RET NZ ...ret. if at EOF ...(for fake scroll do FWD1(1);LSTROW==CRSROW;RET Z;JR LastLine) MR1() ...print 'INSERT' or 'REPLACE' on cmd. line FNDPOS() ...find pos. in buffer to start (DE at char., R.C=col.) if CPB @R7,#EOFCH then begin BLCMR(); QSTION(); RET end ...if at EOF RL1:->CRSCOL ...adjust CRSCOL EIR: RETCRS() ...move cursor to ri ...R.DE at final delim. (also ->CBUFPS); R.C contains length RH1:=@R7; R7:+1 ...delim.->R.B RL1:=0; PUSH R3 ...init. len. count while RL0:=@R7<>RH1 and RL0<>CR do begin ...check for end RL0:->@(R3:+1); RL1:+1; R7:+1 ...copy string into "DEFT" a en(^FILNM,1,->RL0)=-1 then begin ERROR(); RET end PUSHL RR6; R6:=R3 RNDUP(R3:=ENDDAT+1-EBUF; R5:=DEFRL)->R1 write(R6,EBUF,R1,->RL7) close(R6,->RL0) if RL7<>080 then RL0:=RL7 if RL0<>080 then ERROR() POPL RR6; RET PRT0: ...print out msg. until byte te: test on null above not really needed if R1<>0 then begin ...BC=dist. to 1st null or CR R7->R3; R3:+1 LDIRB @R7,@R3,R1 ...shift intervening chars. back 1 sp. end CLRB @R7; POP R7 ...put in null; DE=BUFPOS end else begi FNDPOS() ...get current BUFPOS, ROWNO R7:=BUFP0; NXTLIN() ...DE=new BUFP0 after print FNDCHR() ...DE->BUFP0; if char. at BUFPOS on scr., new row->CRSROW, ... col.->R.C, BUFPOS->DE, Z=1; else Z=0 if not zero then begin PRSCRH(); RET end ght at char. FNDCR() ...get row (->CRROW0) & pos. (->R.DE) of next CR if EIRFLG='I' then R7:=BUFPOS ...if insert mode INNULS() ...spread line, putting in null chars. EIRLUP: GETCHR1(); RL0:->RL7 ...get a char. R3:=BUFPOS if RL0=0 then ...ctrl-@ mrea end R7:->CBUFPS ...advance CBUFPS to after string POP R3; RL1:->@R3 ...store len. at beg. of "DEFT" (may be 0) RL0==RH1 ...set Z flag if ended with orig. delim. instead of CR RET GETNUM: ...enter with R.DE in cmd. buffer; go past spaces till t0; enter with R.HL->text RL0:=@R3==0; RET Z; PUT1(RL0:); R3:+1; JR PRT0 NAMEQ: PRT0(^TXNMQ) ...print "NAME?" R7:=^CMDBUF R3:=read(CONLU,R7,LCMDBUF-1)+R7; RL0:=0D->@R3 RET ERROR: ...write "ERROR ##", where "##"=R.A in hex, on current line; ret. Z=0 n ...if insert mode while RL0:=@R7=0 do R7:+1 ...go to 1st non-null RL0==CR; RET Z ...don't do if at CR CLRB @R7 ...replace char. with null end endif RL1:=CRSCOL ...for printing end else begin ...if was BKSP if RL0:=@(R3:-1)= ...if not on screen (only when top line>page), print scrn + do home RL0:=ROWNO-CRSROW->SCLFLG ...no. of lines to scroll PRSCR() ...print from current pos. while SCLFLG<>0 do begin ...in case got to EOF before n scrolls SCLFLG:-1; LSTROW:-eans put in next char. (except 0) verbatim repeat GETCHR(); RL0:->RL7 until RL0<>0 else begin if RL0=BKSP or RL0=RUBOUT then begin DELCHR(); JR EIRLUP ...delete last or current char. end if RL0=ESC then begin PUSH R3; ABTCML(); POP R3; Jo num. & get it ...Z=1 if no. found; no.->R.HL; else Z=0, HL=1 TONOSP(); R3:=1; RET NZ ... DIGIT(); RET NZ NUMBER(); RET ...no.->R.HL; Z=1 SRCH0: ...get string from cmd. line, store in string buffer; Z=0 if fail ...pos. in text buffer to start searchPUSH R0; PRT0(^TXERR1); POP R0; PUTHEX(RL0:) PUT1(RL0:=CR); RESFLG Z; RET SEEK: ...seek to fpos RR4, type R1 of LU R3 SC SC_SEEK; RET GETFLEN: ...ret. RR2=len of file of LU RL3 R15:-6 R5:=R15; R4:=0FFFF; SC SC_FSTAT LDL RR2,R15[2] R15:+6; RET TSTACR then begin ...check if char. before BUFPOS is CR EIRFLG=='E'; RET NZ ...if not enter mode, don't delete CR CRSROW==1; RET Z ...if on top row, don't delete CR end R3->BUFPOS R3<->R7; CHRPOS() ...find col. of the char. at BUFPOS (->1 POSCRS(RH1:=LROW; RL0:=0); PUT1(RL0:=CR) ...prints LF to scroll end ROWNO:=0 ...0->ROWNO for CONOUT below R7:=^CMDBUF; PUSH R7 ENDROW(); POP R3 ...get DE after CR in cmd buf., R.C=0 CONOUT() ...reprint cmd. line TAGSHW() ...reR EIRX end ...exit end if RL0=CR then begin EIRFLG=='E'; JR NZ,EIRX end ...exit if RL0:=@R3=CR or RL0<>0 and EIRFLG='I' then begin ...if all nulls replaced, add some more PUSH R3; PUSH R7; R3<->R7; INNULS(); POP R7; POP R3 if FULFLG<>0 then b for string after->R.HL TONOSP(); RET NZ ...no string in cmd. line GETSTR(^STRBUF) ...copy string to string buffer if TESTB @R3 zero then begin RESFLG Z; RET end ...set Z=0 if len=0 FNDPOS(); R3<->R7 ...R.HL=buffer pos. if CPB @R3,#EOFCH then R3:=SC: ...test R5 bytes @R3 to see if get non-ascii char before eof char R5==0; RET Z CPB @R3,#EOFCH; RET Z BITB @R3,7; RET NZ R3:+1; R5:-1 JR TSTASC READIT: ...read in file with name @FILNM; ret. R3=length, Z=1 iff succeed ...prints error msg. if failR.C) if CRSCOL=0 then CRSROW:-1 RL1:->CRSCOL ...update cursor pos. if EIRFLG='R' then begin ...if replace mode RETCRS(); RET ...just backspace without deleting char. end R7:=BUFPOS; CLRB @R7 ...put in null char. end endif RL0:=CRSplace tag indicators end CRSROW:+1; RETCRS(); RET ...move cursor down CRSUP: ...move cursor up 1 space if CRSROW=1 and R7:=BUFP0<>EBUF then begin ...if top line & not beg. of file, do fake scroll down R7:-1; LINBEG(); R7:->BUFP0 ROWNO:=1; RL1egin NOROOM(); JR EIRLUP end ...if no room to add any nulls end NEWCHR(); JR EIRLUP ...replace with new char. & print out EIRX: R1:=0 ...R3=BUFPOS coming here if EIRFLG<>'R' then begin ...if insert or enter mode while TESTB @R3 zero do beginEBUF-1 ...if at EOF, pt. before beginning R0==R0; RET ...set Z=1 CMPSTR: ...enter R7 at "DEFT"; R3 at text to be compared; save RL1 ...return Z=1, R3 past string if compares equal; ... else Z=0, R3=1st unsuccessful char. RL0:=@R7==0; RET Z ...if nus R3:=open(^FILNM,0,->RL0) if RL0=0C7 then begin R3:=0; RET end ...not found ok if RL0<>080 then begin ERROR(); RET end PUSHL RR6; R6:=R3 GETFLEN(R6) ...get file len.->RR2 R7:=R3 if R2<>0 or (ENDBUF-EBUF)ROWNO ...for printing PUSH R7; PUSH R1; PRNEW_() ...print starting at current pos. POP R1; POP R7; BLKEND() ...blank chars. left on scr. after CR FULFLG==0; RET Z ...check if buffer was prev. full FULFLG:=0; BLCMR0(); RET ...reset FULFLG; bla:=0; CRROW0:=0 PRNEW_() CRSROW:=CRROW0+1 ... if INSLIN() zero then begin ...if can do "insert line" ... R7:->BUFPOS-1; LINBEG() ... FNDCHR() ...set new BUFP0 & get new CRSROW (for same pos.) ... RH0:=flag; PUSH R0 ... RH6:=CRSROW- ...go to 1st non-null char. (->R3) R3:+1; R1:+1 ...R1=no. nulls end end else ...jump here if replace mode while RL0:=@R3<>CR do begin ...find no. nulls left in line->R.BC if RL0=0 then R1:+1 R3:+1 end endif R3<->R7; SHFTBK()ll string repeat R7:+1; RH0:=@R7==@R3; RET NZ ...unsuccessful R3:+1 until RL0:-1 zero ...no DJNZ RET ...successful (Z=1) ...search text to find string ...BC count; DE points to DEFT 'STRING'; HL points to text ...returns: HL after 1st char. ofTOOBIG) ...print "FILE TOO BIG" close(R6) RESFLG Z end else begin read(R6,EBUF,R7,->RL0) ...read in file PUSH R0 close(R6) POP R0 if RL0<>080 then ERROR() else begin if R5:=100>R7 then R5:=R7 if TSTASC(EBUF,R5) not then nk "NO ROOM" msg. NEWCHR: ...put char. in R.E at HL (=BUFPOS); print updated screen RL1:=CRSCOL if RL7=CR then RL1:=LCOL ...if CR if RL7=TAB then TABPOS() ...if tab RL1:+1 ...R.C=col. pos. PUSH R7; PUSH R3 ...save new char., BUFPOS...->DE & save 1/line FNDPOS(); POP R3 ...find pos. (->R7) if CPB @R7,#EOFCH or R3=0 then begin ...check if EOF or 0 changes ...NOCHG: PRCMR0(^TXTNCH); RET ...print "NO CHG" on cmd. line end CHGFLG:=0; SFLFLG:=0 ...zero flags ROWNO:=1 ...start printing row 1) ...find place for TG2POS if no TAG 2 if CPB @R7,#EOFCH <> then NXTLIN() R7:->TG2POS; RET ...end of 1 tagged line TGSOFF: ...remove & shift file back over tags; correct BUFP0, TG2POS, BUFPOS ...at least tag 1 must be on when come here R3:=^TAGFLG; GFLG==0; JR NZ,ERR1 ...don't do if tags present FNDPOS(); CPB @R7,#EOFCH; JR Z,ERR1 ...find pos. in buf (chk if at EOF) FNDCR() ...find pos. of next CR (R.B=its col.) R7:+1; CPB @R7,#EOFCH; JR Z,ERR1 ...check if on last line of file PUSH R1; PUSH R7AR: ...compare from beg. of line with cursor with from tag 1 pos. ...when get to differing chars., cursor moves to 1st char., tag 2 put ... above line with 2nd char. TAGFLG==1; JR NZ,ERR3 ...must be tag 1 but not tag 2 FNDPSB() ...get DE=beg. current RH1:=CRSROW ...for ROWNO (maybe) if RL0:=RL1>=NCOL then begin ...if goes to next row if RL0:=CRSROW=LROW then MIDPBP() ...print so BUFPOS in mid. screen ^CRSROW; RH1:=@R3 ...RH1 is for ROWNO INCB @R3; RL0:=0 end R3:=^CRSCOL; RL1:=@R3; RL0: if RL0:=@W.STR2-B.STRBUFDIF ...diff. in string lengths if new string longer R1:=ENDBUF-ENDDAT-1 ...empty space in buffer R3:=R7+R1 ...R3=BUFPOS+R1 PUSH R3; PUSH R7 SHFTFD(); POP R7 ...shift rem. part of file to end of bufDECB @R3 if not zero then begin ...if there is a tag 2 DECB @R3; TG2OFF() ...remove TAG 2 end else PLTAG2() ...if no TAG 2, TG2POS=end of line marked by TAG 1 endif R1:=LTAG1; W.TG2POS-R1->W.TG2POS ...correct TG2POS R7:=TG1POS; JR TAGOFF ...r; SHFTBK(R1:=1) ...shift file past CR back 1 space POP R7; POP R1; R7:-1 RL0:=CRROW0==NROW; RET NC ...don't print if CR off screen RL0:->ROWNO; RL1:=RH1; PRSCR(); RET ...print out ERR1: QSTION(); RET ...print "???" LOCATE: ...starting next char., s line R3:=TG1POS+LTAG1 ...HL=just past "--From here:" R3==R7; JR Z,ERR3 ...HL & DE must not pt. same spot while RL0:=@R7=@R3 do begin R7:+1; R3:+1 end PUSH R7; R3<->R7; LINBEG() ...DE=pos. for tag 2 if SETTG2() zero then begin ...put in tag 2 (Z=0->@R3 ...present CRSCOL->R.C; update CRSCOL POP R3; R3:+1->BUFPOS-1 POP R5 ...RL5=new char. RH1:->ROWNO; RH1:=@R3; RL5:->@R3; R3->R7 ...RH1->ROWNO; old char. in buffer->RH1; RL5->buffer; R3->R7 if RL5=CR then begin ROWNO:+1 R1:=-1 rfer R3:=^STRBUF+1; RL1:=@R3; POP R3 ...1st char. in STR1->R.C CHGLUP: while RL0:=@R3<>CR do begin ...check for CR if TESTB STRBUF then RL1:=RL0 ...if 1st string null, then want match if RL0<>RL1 or NCPERL<>'*' and CHLFLG<>0 then begin ...cheemove TAG 1 TG2OFF: RL1:=LTAG2; R7:=TG2POS ...remove TAG 2; drop thru: ... TAGOFF: ...enter with DE=either TG1POS or TG2POS; R.C=LTAG1 or LTAG2 ...blank tag ind. on cmd. line; shift file back over tag ...correct BUFP0 & BUFPOS BLCMR(); TAGSHW(); RH1:earch for string taken from cmd. line ...if at EOF, start at top ...if found, print screen from that line; else "EOF" ..."ctrl R" in string stands for CR SRCH0(); JR NZ,ERR1 ...get str. from cmd. line; HL=start pos. for search-1 R3<->R7; RH1:=@^STR if no room) ...DE at TG2POS, BC=LTAG2 POP R3 ...new cursor pos. if R3>=R7 then R3:+R1 ...if cursor>=tag2 then inc. cursor ptr PUSH R3 if R3:=BUFP0>=R7 then R3+R1->BUFP0 ...inc. BUFP0 if>TG2POS TAGSHW() ...print "TAG 2" on cmd. line epeat R7:+1; R1:+1 until TESTB @R7 not zero ...R7->1st char. past nulls, R1=count of nulls if R1>128 then RL1:=128 INNLS2(RL0:=128-RL1) ...add nulls; R7 pts. after last null PRNEW_(RL1:=0); RET ... PRNWF0(); RET ...if entering Cck if no match with 1st str. char. or doing no more on line CHG2: RL0:=@R3'->@R7'; JR CHGLUP ...move byte back down end PUSH R3; PUSH R7 CMPSTR(R7:=^STRBUF); POP R7 ...check if whole string matches if not zero then begin POP R3; JR CHG2 e=0 ...blank tag ind. from cmd. line (R.C saved) if R3:=BUFP0>R7 then R3:-R1->BUFP0 ...if BUFP0>TGXPOS then BUFP0=BUFP0-LTAGX if R3:=BUFPOS-R7>=zero and R3:-R1TGXPOS then BUFPOS=max(TGXPOS,BUFPOS-LTABUF; RL0:=CR2; PUSH R3 repeat if RL0=@(R3:+1) then LDB @R3,#CR until RH1:-1 zero; ...if a "ctrl R" in string, replace with CR R7:+1; POP R3 ...DE=start pos.; HL->DEFT 'STRING' R5:=0FFFF; LOCSTR() ...search till EOF for string ...if found, DE ptsend POP R7; R7:->TG3POS ...new cursor pos. (set tag 3 there) LOCPRT() ...if new pos. off screen, print so in middle if zero then PRSCRN() ...else reprint screen (tag 2 may change screen) RET SETTG2: ...put in tag 2; enter with DE=pos. for tag ...iR, print rest of screen end PUSH R7; PUSH R1; PRNEW_(); POP R1; POP R7 ...print out RH1==TAB; RET NZ; EIRFLG=='R'; RET NZ ...if replacing a tab, print blanks at end of line: ... BLKEND: ...enter with DE in buffer (not at CR); R.C corres. col. ...prind ...no match R3<->stk; PUSH R3 RL5:=DIF; RH5:=0 if R3-R5BUFPOS R7:+R1; SHFTBK(); RET ...shift back over tag TSTFNM: ...test if filename given in cmd. line; if not, ret. Z=0 ...if so, put drive # at STRBUF+1, followed by DEFT 'FILENAME'; Z=1 FNDSPC(); RET NZ ...if CR or ';' comes before sp., Z=0 . at 1st str. char.; else at EOF ...fall thru: ... LOCPRT: ...if char. at DE (->BUFPOS) on screen, move cursor there, ret. Z=1; ...else print screen so char. in middle, ret. Z=0 R7:->BUFPOS LOCPBP: ...enter here if BUFPOS already set if FNDCH0() not zf room, ret. Z=1, DE=TG2POS, BC=LTAG2; else Z=0 SHFIFR(R1:=LTAG2); RET NZ ...shift rem. file fwd. 11 sp. if room R3->TG2POS ...TG2POS pts. to 1st spot opened up R7:=^TXTTOH; R1:=LTAG2; LDIRB @R3,@R7,R1 ...put in "--To here^" TAGFLG:+1 ...2->TAGFLG nt up to 8 blanks at end of line PUSH R7; FNDCR(); RL1:=RH1 ...find pos. of following CR (R.B=R.C=col) POP R7 RL0:=LROW==CRROW0; RET C ...ret. if CR is off screen if zero then RH1:+1 ...if on last row repeat R7:+1 until RL0:=@R7<>0; ...go past nul pt. to STR2 if RL0:=@R3<>0 then begin RH1:=RL0 ...move STR2 into place: repeat R3:+1; RL0:=@R3->@R7' until RH1:-1 zero; end if CHGALL='N' then begin ...check if doing 1st ocurrence of string R7:->BUFPOS; NUM1:=1; NCPERL:=0 ...so will GETFNM(^STRBUF) ...get drive# & filename to STRBUF RET ERR5: QSTION(); RET COPY: ...copy (without deleting) text bet. tags or on tagged line if no TAG2 ... to right above current line ...if cmd. followed by a filename, copy to the file instead ...keero then begin MIDPBP(); RESFLG Z; RET end RL1:->CRSCOL; RETCRS(); R0==R0; RET ERR2: QSTION(); RET ...illegal CHANGE cmd. C: if RL0:=@R7&UPCASE='O' then begin COPY(); RET end ..."CO" means do COPY CHANGE: ...change STRING1 to STR2; do spec. no. of line R1:=LTAG2; R7:=TG2POS; R0==R0; RET ERR4: QSTION(); RET ...illegal TAG1 or TAG2 cmd. TAG1: TAGFLG==0; JR NZ,ERR4 ...don't do if tag already set FNDPSB() ...find pos. (->DE) & ROWNO of beg. current line SHFIFR(R1:=LTAG1); RET NZ ...shift rem. file fls RH7:=8; if RL0=CR then RH7:=1 if RL0:=NCOL-RH1CHLFLG->CHGFLG ...set change on line & change flags end RL0:=@R3->@R7; PUSH R3 if CHLFLG<>0 then begin ...if a change on the line CHLFLG:-1 if CHGALL='*' then begin ...check if doing all lines PUSH R7; PUSH Rep tags in place TAGFLG==0; JR Z,ERR5 ...chk if tags present if TSTFNM() zero then begin ...test if a filename given TAGRGN() ...HL=beg. of tagged region, DE=end PUTFIL() ...text bet. tags->file PRSCRN(); RET ...only print so know done ends, once or all per line ...start current line TAGFLG==0; JR NZ,ERR2 ...don't do if tags present TONOSP(); JR NZ,ERR2 ...find delimiter GETSTR(^STRBUF); JR NZ,ERR2 ...get 1st string; err if no 2nd delim. RH1:=0; R3:+1+R1->STR2 ...where to put 2nd swd. 13 sp. if room R3->TG1POS ...TG1POS pts. to 1st spot opened up R7:=^TXTFRH; R1:=LTAG1; LDIRB @R3,@R7,R1 ...put in "--From here:" TAGFLG:+1 ...1->TAGFLG R7:=TG1POS; JR TAGX ...print "TAG 1", fill screen, get allow. cmds. TAG2: TAGFLG==1; JR NZ,et. cursor T: if RL0:=@R7='1' then begin TAG1(); RET end ..."T1" means go to TAG1 if RL0='2' then begin TAG2(); RET end ..."T2" means go to TAG2 if RL0='3' then begin TAG3(); RET end TOP: ...prints out 1st part of file, filling screen PRSCR0(R7:=EBUF1 LINBEG(); RL1:=0; PRLIN() ...print out line with change if not zero then SFLFLG:=1 ...indicates screen full POP R1; POP R7 end end R7:+1; POP R3; R3:+1 NUM1:-1; JR Z,CHGX ...chk if done CPB @R3,#EOFCH; JR NZ,CHGLUP ...if not EOF COPY1(); if zero then PRSCRB(); RET ...copy text; print out COPY1: ...if all OK, copy text bet. tags, ret. Z=1; else ret. Z=0 ...update BUFP0, BUFPOS, TG1POS, TG2POS TAGRGN(); R3->NUM1 ...beg. of text to be copied PUSH R3; FNDPS0(); R7:->BUFPOS ..tring (R.C=len.) GETSTR(R3) ...get 2nd string if zero then begin ...2nd string ends with delimiter, not CR or ";" R7:+1 if RL0:=@R7='n' then RL0:='N' ...'N' indicates do next occurrence RL0:->CHGALL ...if ='*', indicates do all lines if RERR4 ...tag 1 must be already set but not tag 2 FNDPSB() ...find pos. (->DE) & ROWNO of beg. current line R7==TG1POS; JR ULE,ERR4 ...must be after TAG 1 pos. SETTG2(); RET NZ ...put in tag 2 (Z=0 if no room); TG2POS->DE TAGX: if RL0:=@^CRSROWTG1POS and R7<=TG2POS then begin JR NZ,ERR5; TAGFLG==1; JR NZ,ERR5 ...if DE bet. tags; Z=0 end PUSH R7; PUSH R1 SHFIFR(); POP R1; POP R7; RET NZ ...shift file fwL0='*' or RL0='N' then begin R7:+1; R3:=0FFFF ...no limit on no. of lines end else begin ...DIGIT(); JR NZ,CHG1 ...check if no. NUMBER(); JR NZ,CHG1 ...complete no.->R.HL end SPC() ...skip spaces; 1st non-space char.->R.A end elshen INCB @R3 ...keep cursor same rel. pos. TAGSHW(); PRSCRC() ...print TAG 1/TAG 2 on cmd. line; print out screen RET TAG3: FNDPOS(); R7:->TG3POS; RET OFF: RL0:=TAGFLG if CPB @R7,#'2' then begin ..."O2" means OFF2 RL0==2; JR NZ,ERR4 ...check if...print screen with current line in middle; cursor stays with line FNDPOS() ...fall thru: ... MIDPBP: ...print screen so char. at BUFPOS & cursor in middle R7:=BUFPOS ...MIDPRT: LD (BUFPOS),DE ...no longer used CHRPOS(); RL1:->CRSCOL; PUSH R1 ...saere doing all lines R3:=^ROWNO if SFLFLG=0 then DECB @R3 SCRRES(RL1:=@R3); RET ...blank rem. scr.; wait for key hit; reprint scr. end if RL0='N' then begin ...chk doing next occur. if CHGFLG<>0 then begin LOCPBP(); RET NZ end ...ifd. to make room if R7<=TG1POS then begin W.TG1POS+R1->TG1POS; W.TG2POS+R1->TG2POS; W.NUM1+R1->NUM1 end ...update tag positions if shifted fwd. R1==0; RET Z; R3:=NUM1; LDIRB @R7,@R3,R1 ...move text CRSCOL:=0; R0==R0; RET ...cursor->1st col.; Z=1 e begin CHG1: R3:=1; RL0:=0->CHGALL ...default=1 line, once per line end endif R3->NUM1; PUSH R3 ...NUM1=no. of lines to do RL0:->@^NCPERL ...if NCPERL<>'*' then once per line if RL0:=B.STRBUF=0 then RL0:->@R3 ...if 1st string is null, only do  a TAG 2 TAGFLG:-1; FNDPOS(); TG2OFF() ...remove TAG 2 end else begin RL0==0; JR Z,ERR4 ...check if any tags FNDPOS(); TGSOFF() ...remove tags end FNDCH0(); PRSCRN(); RET ...find CRSROW of new BUFPOS; print scr. PLTAG2: R7:=TG1POS; NXTLIN(ve RH1 LINBEG(); PIKROW(RL0:=LROW/2-1); POP R1; RH1:+1; R3:=^CRSROW while RL0:=@R3R.HL; end->R.DE->TG2POS R7:=TG2POS if TAGFLG=1 then PLTAG2() ...if no TAG 2, find pos. for it->DE R3:=TG1POS+LTAG1; RET G: if RL1:=@R7>='1' and RL1<'4' then begin ...goto tag 1, 2 or 3 RL1:=(RL1-'1')*2; RH1:=0age; repeat n times; print GETNUM() ...get no. after cmd., default=1 R7:=BUFP0 ...in case 0 while R3<>0 do begin R3:-1; PUSH R3 RL0:=LROW->CRSROW; CRSCOL:=0; FNDPS0() R7:->BUFP0; POP R3 ...beg. last line on page->DE->BUFP0 end PRSCR0(); RE) SETSCRSZ() SETKEYS() CLRSCR(); POSCRS(RL0:=0; RH1:=1) ...LROW-2) PRT0(^REVMSG) RET SETSCRSZ: ...set LROW,LCOL from NROW,NCOL LROW:=NROW-1; LCOL:=NCOL-1; RET SETKEYS: ...put KEYVEC (not DELKEY) in cmd table R3:=^KEYVEC; R5:=^CMDTBC2; R1:=LKEYVEC;R7 then begin ...if BUFP0>=TG2POS R3:-R1->BUFP0 ...BUFP0=BUFP0-len. bet. tags W.BUFPOS-R1->W.BUFPOS ...BUFPOS=BUFPOS-len. bet. tags end else begin ...if BUFP0 bet. tags R1:=TG1POS->BUFP0 if R3:=BUFPOS-R7CBUFPS; RET ...pt. CBUFPS to end of cmd. line SHOW: ...print screen, either showing CR's as "~" or tab R7:=TGPOS[R1] if W.ENDDAT=R7 then R3<->R7 LOCPRT(); RET end GET: ...get a file, inserting above current line RL0:=@R7 &UPCASE=='E'; JR NZ,ERR6; TAGFLG==0; JR NZ,ERR6 TSTFNM(); JR NZ,ERR6 ...get filename FNDPSB() ...get BUFPOS T ...print out screen PREV: ...back up to prev. page: curr. 1st line becomes last line if possible ...do n times, then print page GETNUM() ...get no. after cmd.; default=1 R7:=BUFP0 while R3<>0 do begin R3:-1; PUSH R3; PKLROW(); POP R3 end PRSC LDIRB @R5,@R3,R1; RET GETTERM: ...can test between diff. terminals (if can) & possibly change SCRVEC ... or just RET if not to change default terminal /IF TSTV2SW=0 THEN RET /ELSE ...below is set to test between Infoton 200 & Visual 200: ASKCRT(^RQIDG2POS R1:->BUFPOS ...then BUFPOS=TG1POS else R3:+R1->BUFPOS ...else BUFPOS=TG1POS+(BUFPOS-TG2POS) endif end endif end endif FNDCH0(); PRSCRN(); RET ...find row corr. to BUFPOS->CRSROW; print scr. FORWRD: ...if no. given, print scres as "~"+spaces RL1:='~' if RL0:=@R7 &UPCASE='T' then begin ..."ST"=>show tabs RL1:->SHOWTB; PRSCRN(); SHOWTB:=' '; RET end RL1:->SHOWCR; PRSCRN(); SHOWCR:=0; RET QUIT: ...quit edit session if RL0:=@R7 &UPCASE<>'U' then begin QSTION(); RET end .+ R7=pos. & ROWNO=row at beg. of line GETFIL() ...read in file if zero then begin R7:->BUFPOS; CRSCOL:=0 ...for printing (beg of read-in text) CRSROW:=ROWNO ...adjust cursor row end PRSCRB(); RET ...print out (BUFPOS=start of new text) ERR6:R0(); RET ...BACK: ...if number given, go back that many lines & print screen ... ...if no number, current line->last line ... ...cursor stays with current line unless off screen ... if GETNUM() not zero then begin ... FNDPS0(); PUSH BUFPOS; PKLROW(); PV2) ...send msg. for request terminal id for Visual 200 ...Z=1 =>default (Infoton 200), Z=0 =>Visual 200 ...note: after request id, Visual 200 doesn't work unless clear screen if not zero then SETV2() RET CKCRTCT: WORD 800 ...# of times to loop waiten starting n lines down from top ...if string given, do FIND; else print starting at current line ...cursor stays with curr. line unless off screen if GETNUM() not zero then begin ...check if a no. follows cmd. SRCH0(); JR Z,FIND ...chk if a strin..must be "QU" R7:+1; DUNFLG:+1 ...set DUNFLG=1 if SPC() and RL0:&UPCASE='N' then DUNFLG:+1 ...if "QU N", don't write out file (DUNFLG=2) if TAGFLG<>0 then TGSOFF() ...remove tags if present POSCRS(RL0:=0; RH1:=LROW); ERASL() ...cursor->last line QSTION(); RET ...ill. cmd.; print "???" DELETE: ...delete n lines starting at current line ...if tags present, delete bet. tags RL0:=@R7 &UPCASE=='E'; JR NZ,ERR6 ...must be "DE" R7:+1 if TAGFLG<>0 then begin RL0:=@R7 &UPCASE=='T'; JR NZ,ERR6 ..OP BUFPOS ... ...if no no. given: get BUFPOS & R7=next BUFP0 ... end ... else begin ...if no. given (in R3) ...BAK1: R7:=BUFP0 ...alternate entry pt. ... while R7<>EBUF and R3<>0 do begin ...chk if done or to beg. of file ... R3:-1; PUSH Ring for CRT response (>=500) ...(formerly 300,>=165) RQIDV2: ...msg. to request V200 id which will not print on I200 BYTE CRSXYI2 ESC 'Z' 0 ASKCRT: ...output string @R3; chk if anything back, if so, goes to RH1,RL1 ...return Z=1 iff no response repeag follows cmd. FNDPS0() ...no no. or str.: get BUFPOS & DE=next BUFP0 end else begin ...if no. (now in HL) FWD1: R7:=BUFP0 ...count from top line (alternate entrance here) while R3<>0 and CPB @R7,#EOFCH <> do begin ...check done or EOF R & clear it RET TAGFLG<>0 then TGSOFF() ...remove tags if present POSCRS(RL0:=0; RH1:=LROW); ERASL() ...cursor->last line & clear it RET RET t RET LG:+1 ...set DUNFLG=1 if SPC() and RL0:&UPCASE='N' then DUNFLG:+1 ...if "QU N", don't write .if tags, must have "DET" FNDPOS(); DELBTG(); RET ...del. bet. tags; remove tags; print end GETNUM() ...get no. lines to delete->HL; default=1 PUSH R3 FNDPS0(); PUSH R7 ...find pos. in buffer; save beg. of line CHRPOS() ...get rows in line-1->R3 ... R7:-1; LINBEG(); POP R3 ...go to beg. of prev. line ... end ... PUSH R7; FNDPOS(); POP R7 ...get BUFPOS; DE=next BUFP0 ... end ... FNDCHR(); RH0:=flag; PUSH R0 ... ...get new cursor pos. if char. on screen (Z=1) ... PRSCRN(); POP R0; RHt GET1IF() until not zero; ...get rid of any pending input PRT0(R3) R1:=0; R3:=CKCRTCT; RL7:=0 repeat if GET1IF() zero then begin RH1:=RL1; RL1:=RL0; RL7:+1 end until R3:-1; RL7==0; RET SCRV2: BYTE CSADROV2 ESC CLRV2|080 ERSLV2|080 CRSYXV2|080 IN3:-1; PUSH R3; NXTLIN(); POP R3 ...go to next line end PUSH R7; FNDPOS(); POP R7 ...get BUFPOS; DE=next BUFP0 end if FNDCHR() not zero then begin PRSCRH(); RET end PRSCRN(); RET ...get new cursor pos.; print out FIND: ...search for string takeH1 RL0:=CRSROW-RH1->CRSROW->ROWNO ...1st row of line CRSCOL:=0; R1:=0 POP R3; POP R7; PUSH R3 ...HL=beg. line pos.; DE=no. lines to delete while R7<>0 and CPB @R3,#EOFCH <> do begin ...go thru buffer counting lines until n lines or EOF R7:-1; R 0:->flag ...print screen ... if not zero then CRSBTL(); RET ...if Z=0, set cursor to bottom line XEQ: ...execute command line RL7:=RL0; BLCMR() ...'X'->R.E; blank right part cmd. line ^XCMBUF; PUSH R3 ...start of "X" cmd. buffer RH7:=NCOL-(RTL-1) SLV2|080 SETV2: ...put codes for V200 in SCRVEC R3:=^SCRV2; R5:=^SCRVEC; R1:=LSCRVEC; LDIRB @R5,@R3,R1; RET /ENDIF REVMSG: ...version msg. (leave this last thing before ENDE) DEFM ' SCREEN EDITOR - 11/22/82' BYTE CR 0 ORG $+1&0FFFE ENDE: ...noten from cmd. line at beginning of a line ...if found, print screen from that point; else "EOF" ...entered with HL=start pos. for search: ...start search line after cursor pos.; if at EOF, start at top FNDLUP: RL0:=CR; R1:=0; CPIRB RL0,@R3,R1,EQ ...find L0:=CR; CPIRB RL0,@R3,R1,EQ ...find beg. next line end R3<->R7; R1:=-R1 ...no. of chars. to delete->R.BC SHFTBK() ...shift file past deleted lines back; update ENDDAT POP R7; PRSCRC(); RET ...print out MOVE: ...move (& delete) text bet. tags or on...R.D=beg. col. for cmd. print RL0:=NCOL-(RTL-4) ...R.A=last col. for "X" cmd (not counting CR) FILCL2(); POP R7 ...fill "X" cmd line; DE=beg. BLCMRF:=1 ...flag something on rt. part cmd. line if not zero then begin ...chk if to execute R7:+1 : make label EBUF0 =beginning of text buffer (there must be 1 free space ... before this) & label EBUF9 =address 1 past end of text buffer ...Example: EBUF0 EQU ENDROM&0FF00+0100 ... EBUF9 EQU EBUF0+((0F900-EBUF0)/0200*0200)  n 200 or Visual 200) inext CR if CPB @R3,#EOFCH <> then begin ...check if to EOF R7:=^STRBUF; CMPSTR() ...test string with text following CR JR NZ,FNDLUP ...if test failed end R3->R7; LINBEG() ...find beg. of line PRSCR0(); RET ...print out screen NAME: ...print tagged line if omly 1 tag ... to right above current line ...if a filename given, move to the file instead TAGFLG==0; JR Z,ERR6 ...chk if tags present if TSTFNM() zero then begin ...test if a filename given FNDPOS() ...get BUFPOS TAGRGN(); PU if GETNUM() not zero then begin ...chk if no. follows 'X' ...note: R3 set=1 in GETNUM if CPB @R7,#'*' then R3:-2 ...if "*", then R3=0FFFF end repeat R3==0; JR Z,XEQX PUSH R3; ESCFLG:=0 XEQCML(); POP R3; R3:-1 until ESCFLG<> ...go to 1st non-null char. (->R3) R3:+1; R1:+1 ...R1=no. nulls end end else ...jump here if replace mode while RL0:=@R3<>CR do begin ...find no. nulls left in line->R.BC if RL0=0 then R1:+1 R3:+1 end endif R3<->R7; SHFTBK()  name of file currently being edited POSCRS(RL0:=0; RH1:=1); ERASL() ...go to 1st line & erase it ... B.@^FILDNM=='*'; RH1:='/'; if not zero then OUTTWO() ...print drive no. PRT0(^FILNM) ... RH1:=@(R3:=^FILNML) ... repeat PUT1(RL0:=@(R3:+1)) until RH1:TFIL() ...copy text to file end else COPY1() ...copy text to above curr. line endif RET NZ ...cont. below: ... DELBTG: ...delete text bet. tags, removing tags; correct BUFP0, BUFPOS; print TGSOFF() ...remove tags; TG1POS=beg. & TG2POS=end of text0 or GET1IF() zero and RL0=ESC; ...execute cmd. line HL times or until escape end XEQX: ...if tags, replace tag indicators: ... TAGSHW_: TAGSHW: ...print "TAG 1" / "TAG 2" on right part cmd. line TAGFLG==0; RET Z ...if no tags PRCMR1(^TXTTG1) .. ...shift file back over nulls FULFLG:=0 BLCMR(); RET ...blank out right part of cmd. line; ret. cursor INNULS: ...expand line, inserting n null chars. in buffer (updating ENDDAT) ...n=lesser of 128 or available space (returned in R1) ...enter with R-1 zero; ...put out name RL1:=1 ...fall thru: ... SCRRES: ...blank rem. screen after row R.C; wait for key hit; reprint scr. BLNKLS() ...fill rem. scr. with blank lines HITKEY() ...print "HIT KEY" on cmd. line POSCRS(RL0:=0; RH1:=1) ...move curso... part 3 of Editor TSTV2SW: EQU 0 ...=1 if to test between Infoton 200 & Visual 200 terminals ...=0 if to just use default (presently Infoton) without testing ...see GETTERM below CRTTYP: ...determine type of CRT (Infoton 200 or Visual 200) i to be del. R7:=TG2POS; R1:=R7-TG1POS ...R1=len bet. tags PUSH R1; SHFTBK() ...shift back file over deleted portion POP R1 ...len. deleted if R3:=BUFP0TG2POS then begin ...if TG2POS1 then ^TXTTG2 PRCMR0() ...if 2nd tag, print "TAG 2" to right of "TAG 1", else blanks INCB @R3; RET ...set BLCMRF (@R3) to 2 WAIT: ...wait for keystroke; if not escape, go do next cmd. on cmd. line ...else return t7->buffer loc. of char. to insert nulls before RL0:=128 INNLS2: ...supply R.A when enter here R3:=ENDBUF-ENDDAT-1; RL1:=RL0; RH1:=0 ...avail. space in buffer->R3; RL0->R1 if R3BUFPOS ...BUFPOS=BUFPOS-len. bet. tags end else ...if TG2POS>=BUFPOS if R3:=TG1POSBUFPOS endif ...if BUFPOS bet. tags, BUFPOS=TG1POS endif end else begin ...if BUFP0>=TG1POS R7:=TG2POS ...R3=BUFP0 if R3>=o cmd. mode HITKEY() ...print "HIT KEY" on cmd. line WAITCH() ...wait for char. from keybrd; test esc.; blank cmd line msg. JR TAGSHW ...if tags, restore tag msgs. WAITCH: GETCHR(); RL0:->RL1 ...get char. from cons. BLCMR0() ...blank "HIT KEY" ms =0 ...reset flag if R1=0 then begin FULFLG:+1; RET end ...set flag for buf. full PUSH R1; SHFTFD() ...shift file past R.DE fwd. to make room for nulls LDB @R3,#0; R3->R7; R7:+1 ...R3 pts. to 1st opened-up space R1:=@R15-1 if R1<>0 then LDIRB @R7,@e you will be able to ... "GE"t from the editor to do the extensions in it. Note that EE must be ... present on disk, and that the assembled extension file must fit between ... 0F900 and 0FFFF. ...below assumes Y & EE in seg. 1: E0: ADDR 0 ...beginning 0 if R5>R1 then R5:=R1 R2:=MAGNIF R3:=R3-BOTTOM ...offset from bottom SDL R3,R2; R3:*2 R5:=R5-BOTTOM ...offset from bottom SDL R5,R2; R5:*2 R1:=0 repeat R1:+TIMEIN[R3] until R3:+2>R5 R3:=R1 printf("Qume= %W\n",R3) RET /SETIT() /WRITE "Have WOpeat R7:+1; R1:+1 until TESTB @R7 not zero ...R7->1st char. past nulls, R1=count of nulls if R1>128 then RL1:=128 INNLS2(RL0:=128-RL1) ...add nulls; R7 pts. after last null PRNEW_(RL1:=0); RET ... PRNWF0(); RET ...if entering CRk if no match with 1st str. char. or doing no more on line CHG2: RL0:=@R3'->@R7'; JR CHGLUP ...move byte back down end PUSH R3; PUSH R7 CMPSTR(R7:=^STRBUF); POP R7 ...check if whole string matches if not zero then begin POP R3; JR CHG2 enR3,R1 ...fill opened-up space with 0's POP R1; RET DELCHR: ...if R.A=BKSP: delete char. before BUFPOS; if replace mode just bksp. ...if R.A=RUBOUT: delete char. at BUFPOS, but not CR ...come here with HL=BUFPOS if RL0=RUBOUT then begin CPB @R3,#CRof editor W: ADDR 02000 in 1 X: ADDR 0F900-4 in 2 ...4-byte header will be prepended to code image .../DO EE ...bring in E image ORG W ...E_VERS: BYTE at E0+0B ...VERSN: EQU value(RL3:=E_VERS;RH3:=0) EEX0: WORD at E0+0C ECODE0: WORD at E0+0E EBUF: WORDRDs: BOTTOM,TOP,SEGN (initially=0,0FFFF,08000)" /WRITE "Commands are: START STOP SHOW QUME(LO,HI)" "Have WORm SDL R5,R2; R5:*2 R1:=0 repeat R1:+TIMEIN[R3] until R3:+2>R5 R3:=R1 printf("Qume= %W\n",R3) RET /SETIT() /WRITE "Have WO!&o !Ro { p { JJp܉n  { ,,pܒn ܛL`  {  { j`  `{   .{p!Qȗ٩p pҫp { pp { p {  pjd ...no match R3<->stk; PUSH R3 RL5:=DIF; RH5:=0 if R3-R5R7; R1:=0 if RL0='R' then begin ...if replace mode TESTB @R3; RET Z ...if at null PUSH R3 while RL0:=@(R3:+1)<>0 and RL0<>CR do R1:+1 ...not at E0+010 ENDDAT: WORD at E0+012 ENDBUF: WORD at E0+014 LOCSTR: PROC at E0+016 NEWSTR: PROC at E0+01A LINBEG: PROC at E0+01E NXTLIN: PROC at E0+022 NUMBER: PROC at E0+026 XMGCNO: EQU 0EE0E ...magic no. for editor extension file .../if ENDBUF>0F900 thenIV1.00 .!}:o*oo o ],!P]! j] ]!}NR; RET register COL:RL1 ECODE: LINBEG() L1: NR==0; RET Z; COL:=NC==0; RET Z L2: B.@R7==0FF; RET Z repeat COL:-1 if RL3:=@R7=0D then begin NR:-1; RET Z if COL<>0 then begt. to STR2 if RL0:=@R3<>0 then begin RH1:=RL0 ...move STR2 into place: repeat R3:+1; RL0:=@R3->@R7' until RH1:-1 zero; end if CHGALL='N' then begin ...check if doing 1st ocurrence of string R7:->BUFPOS; NUM1:=1; NCPERL:=0 ...so will se: test on null above not really needed if R1<>0 then begin ...BC=dist. to 1st null or CR R7->R3; R3:+1 LDIRB @R7,@R3,R1 ...shift intervening chars. back 1 sp. end CLRB @R7; POP R7 ...put in null; DE=BUFPOS end else begin begin Errm(); DEFT "E's buffer too long" end; TXDO: DEFM 'DO ' SRCFIL: BYTE ' '[36] TXIMG: DEFM 'IMAGE ' IMGFIL: BYTE ' '[70] FILNML: BYTE 0 FILNM: DEFS 41 SAVDE: WORD 0 ENDNM: WORD 0 QCMD: PUSH R7; R3->R7; COMMAND(); POP R7; RET GETNM: ...get filenam78 88&848B8P8^4.x!p4.nT $G7B]4/!0:J70L8.CON4-4!@B_5 潒baL8L8!o8r!! %UU !UU % !/!a` ^B!s RH7:=8; if RL0=CR then RH7:=1 if RL0:=NCOL-RH1CHLFLG->CHGFLG ...set change on line & change flags end RL0:=@R3->@R7; PUSH R3 if CHLFLG<>0 then begin ...if a change on the line CHLFLG:-1 if CHGALL='*' then begin ...check if doing all lines PUSH R7; PUSH R1...editor extension to right justify text (keep within n columns) ...call by .J m,n (m=# cols. wide to make, n=# lines to do) NC: BYTE 0 NR: BYTE 0 TXTCR: BYTE 1 0D SP: while B.@R7=' ' do R7:+1; RET EEX: B.@R7&0DF=='J'; RET NZ; R7:+1; SP(); NUMBER(); REe to buffer @R3; rets. R5 after CR PUSH R3; Getcon(RL0:='?'); POP R5 repeat RL0:=@R7'->@R5' until RL0=0D; RET LDDE: R7:=SAVDE; RET DOIT: R7:->SAVDE; QCMD(^TXDO); RET IMAGEIT: R7:->SAVDE; QCMD(^TXIMG); RET EXTEND:= "##" LDDE / "!!" DOIT / "%%" IMAGEIT ;  !7.X3.XC: ::::13L8g7Q7^5f8~b8~{

NC; B.@R7==','; RET NZ R7:+1; NUMBER(); RET NZ; RL3:->NR; RET register COL:RL1 ECODE: LINBEG() L1: NR==0; RET Z; COL:=NC==0; RET Z L2: B.@R7==0FF; RET Z repeat COL:-1 if RL3:=@R7=0D then begin NR:-1; RET Z if COL<>0 then beg  /?"Enter Name of Source File:" /GETNM(^SRCFIL); RL0:='#'->@R5'->@R5'; RL0:=0D->@R5 W: ADDR $ ORG X X0: WORD XMGCNO X1 X1: ...B.E_VERS==VERSN; RET NZ ...chks if E same version as used for extn. EEX0:=^EEX; ECODE0:=^ECODE; R0==R0; RET ...links in extn( #   ^h?⠉o  f8^ xb8{^ :{Ѐ:: :4::~ ߼:::78 39  '2' ! 2::4:%1#21; RET ...B: if RL0:=@R7&UPCASE='A' then begin BACK(R7:+1); RET end ... ..."BA" means BACK BOTTOM: R7:=ENDDAT; PKLROW(); CRSCOL:=0 PRSCRF(); RET ...print last page of file M: if RL0:=@R7&UPCASE='O' then begin MOVE(); RET end ..."MO"=do MOVE MIDDLE: .tart the CTC, clear histogram ...enter with BOTTOM,TOP,SEGN set R3:=SEGN; RL3:=0; SET R3,15; R3->SEGN Tswitch:=0 R2:=255; R4:=^TIMEIN; R5:=R4+2 CLR TIMEIN; LDIR @R5,@R4,R2 ...zero array R2:=TOP-BOTTOM; SRL R2,8 R3:=-1 while R2:/2 not do R3:-1 MAGin if NC-1<>COL and RL3:=@R7[1]<>' ' and RL3<>0D then begin B.' '->@R7' end else begin PUSH R1; NEWSTR(^NULSTR,1); POP R1; COL:+1 ...PUSH saves COL end JR L2 end R7:+1; JR L1 end if RL3=9 then begin if . !! ...assemble source file X: ADDR $ X9: ORG W /?"Object code goes from 0",^X1," to 0",^X9 /R3:=^X9; if BIT R3,15 zero then ?"DANGER: TOO LONG";? /?"Enter Name for Object File: (or just hit 'return' to skip)" /GETNM(^IMGFIL); if RL0:=B.IMGFIL<>0D t03$j8&2$#j8:ȃ:!1!:B !<$G<%<-<#<+5+1+7+3+!!1!: @5+7+M8L8/L85`L8<T@:J,L8L81..print screen with current line in middle; cursor stays with line FNDPOS() ...fall thru: ... MIDPBP: ...print screen so char. at BUFPOS & cursor in middle R7:=BUFPOS ...MIDPRT: LD (BUFPOS),DE ...no longer used CHRPOS(); RL1:->CRSCOL; PUSH R1 ...savNIF:=R3 RET START: PROC SETIT() LDL RR2,#0FFFF,RTCINT R0:=Intclk SC 1 ...set timer R3:=1; LDR Tswitch,R3 ...runs segmented and non segmented RET STOP: PROC R3:=0; LDR Tswitch,R3 RL0:=0; SC 1; RET /SEG ... interrupt handler follows RTCINT: PROCCOL:-7ENDNM; Copy(); DEFT ' X:X0 X9-1 '; RL0:=0D->@R7' RL0:='#'->@R7'->@R7'; RL0:=0D->@R7 end; W: ADDR $ /IF B.IMGFIL<>0D THEN ORG X %% ...QCMD(^TXIMG) ORG W ...MOVFNM: R3:=^IMGFIL; R5:=^FILNM; R1:=0 ... while RL0:=@R3<>' ' and RL+!.(o8K83+L80 8!8ĞjL8< 4 B:@_`TR7 …U7)~ 7)v 4)v  ߲Ȁ($ O  pp  Oe RH1 LINBEG(); PIKROW(RL0:=LROW/2-1); POP R1; RH1:+1; R3:=^CRSROW while RL0:=@R3=BOTTOM and R30 then begin R2:=MAGNIF R3:=R3-BOTTOM ...offset from bottom SDL R3,R2; R3:*2 INC TIMEIN[R3],1 end POPL RR2 IRET /NONSEG SUM: WORD 0 SUM1: Wil RL3=' '; R0:=0 repeat R0:+1; R7:-1 until B.@R7<>' '; R7:+1 if R0=1 then B.0D->@R7' else NEWSTR(^TXTCR,R0) JR L1 until RL3=' '; R0:=0 repeat R0:+1; R7:-1 until B.@R7<>' '; R7:+1 if R0=1 then B.0D->@R7' else NEWSTR(^TXTCR,R0) JR L1 ^NR; 0<>0D do begin RL0:->@R5'; R3:+1; R1:+1 end ... RL1:->FILNML; RET ...ATT: BYTE 08E 0 ...SETSBT: R3:=open(^FILNML,0,->RL5) ... if R3=-1 then begin ?"OPEN ERROR ",RL5; Err0(RESFLG Z) end ... RH0:=RL3; R2:=0FFFF; R3:=^ATT; R1:=1; RL0:=1; SC 0; RET ...*MOVFAȀ  H  4*s! H.(0P4*V.I驓 I PNE4(p 7CU5)a8x5'  B!B>S T4   K8r!7)5o8x5)|7)~1)xFLG==0; JR NZ,ERR1 ...don't do if tags present FNDPOS(); CPB @R7,#EOFCH; JR Z,ERR1 ...find pos. in buf (chk if at EOF) FNDCR() ...find pos. of next CR (R.B=its col.) R7:+1; CPB @R7,#EOFCH; JR Z,ERR1 ...check if on last line of file PUSH R1; PUSH R7;ORD 0 HS: PROC POP R3,@R10 R4:=0; R5:=R3 ADDL RR4,SUM LDL SUM,RR4 RET SHOW: PROC STOP() 0->SUM->SUM1 ...zero the total R8:=BOTTOM R3:=-MAGNIF; R9:=16; SDL R9,R3 ...address increment R10:=^TIMEIN repeat printf("%W: %W%W %W%W %W%W %W%W %DEC (HL); RET Z if R.C<>0 then begin if NC-1<>R.C and @(R.DE+1)<>' ' and R.A<>0D then begin ' '->@DE; INC DE end else begin PUSH BC; NEWSTR(1;^NULSTR); POP BC; INC C end JR L2 end INC DE; JR L1 end if R.NM(); SETSBT() ...set subtype 0E in file just imaged /ENDIF H0:=RL3; R2:=0FFFF; R3:=^ATT; R1:=1; RL0:=1; SC 0; RET ...*MOVFNM(); SETSBT() ...set subtype 0E in file just imaged /ENDIF F DIF ged /ENDIF G: BYTE 0 ...set by QUIT to 1 (or 2 if not opFg`upF5)XݟFp6eFfc0cpFc g6SuFeQ!Gg/G5S3B3ݿ5(H5SFYyw0&7Yi0&)cF\ 85BS77(13(K3o58+3a38...note: must be changed /?"EDITOR EXTENSIONS.MAKE" ...to use, /DO EE.X.M. It asks for name of source file (which contains the ... routines EEX and ECODE, an example is XRJ.S). It then asks for name of ... file to image to (such as XRJ), which is the filW%W %W%W %W%W %W%W\n",R8,HS,HS ,HS,HS,HS,HS,HS,HS,HS,HS,HS,HS,HS,HS,HS,HS) R10:+020 R8:+R9 until carry or R8>TOP; printf("Total= %W%W\n",SUM,SUM1) RET QUME: PROC R0:=BOTTOM; R1:=TOP if R3>R5 or R3>R1 or R5@R3 ...present CRSCOL->R.C; update CRSCOL POP R3; R3:+1->BUFPOS-1 POP R5 ...RL5=new char. RH1:->ROWNO; RH1:=@R3; RL5:->@R3; R3->R7 ...RH1->ROWNO; old char. in buffer->RH1; RL5->buffer; R3->R7 if RL5=CR then begin ROWNO:+1 R1:=-1 reto write file out) CMDSW: BYTE 0 ...if =0, cmds. from cons.; =1, cmds. from cmd file SVENDB: WORD 0 ...save orig. ENDBUF when allocate sp. for cmd file buff. CMFPOS: WORD 0 ...pos. in cmd. file buffer for next char. to be gotten BUFP0: WORD EBUF0 ...po *740}2?}:}2?}:59P!@8 % F G%s NOT FOUND\nF GOPEN (of EE) ERROR %B\nC!! !B F GREAD (of EE) ERROR %B\nACn starting n lines down from top ...if string given, do FIND; else print starting at current line ...cursor stays with curr. line unless off screen if GETNUM() not zero then begin ...check if a no. follows cmd. SRCH0(); JR Z,FIND ...chk if a string==0) { hexcode{BD309464210100907F42A138} /* get line of input */ /* {R3:=0; LDL RR4,buf; R1:=144; SC 042; rdcnt:=R3} */ if (rdcnt<=0) {_RDCNT=0; return(-1);} _RDCNT=rdcnt; _BUFIDX=0; } _RDCNT-=1; return(buf[_BUFIDX++]); } /***************QSTION(); RET ...ill. cmd.; print "???" DELETE: ...delete n lines starting at current line ...if tags present, delete bet. tags RL0:=@R7 &UPCASE=='E'; JR NZ,ERR6 ...must be "DE" R7:+1 if TAGFLG<>0 then begin RL0:=@R7 &UPCASE=='T'; JR NZ,ERR6 ...LFIL~ EQU NLVLS+1 ...list file LU level CONLU~ EQU 2 SC_RDHDL~ EQU 012 ...SC # to read current break handler SC_WRHDL~ EQU 013 ...ditto write SC_IO~ EQU 0 SC_SEEK~ EQU 5 SC_MREQ~ EQU 010 ...SC to request memory buffer SC_MREL~ EQU 011 ...DEFRL~ EQU 020AQ!@8 F GCREATE (of EEE) ERROR %B\nC!a!CKF GWRITE (of EEE) ERROR %B\nACA!!A gAohAoA oF G >E2!!B!!s  p_Z$F G E follows cmd. FNDPS0() ...no no. or str.: get BUFPOS & DE=next BUFP0 end else begin ...if no. (now in HL) FWD1: R7:=BUFP0 ...count from top line (alternate entrance here) while R3<>0 and CPB @R7,#EOFCH <> do begin ...check done or EOF R3**************************************************/ errno=0; /* open-write below assume 1st reg. var (errno_)->R6, 2nd (retval)->R7 */ open(name) char *name; { /* assumes 1st reg. var (errno_)->R6, 2nd (retval)->R7 */ register int errno_,retval; if tags, must have "DET" FNDPOS(); DELBTG(); RET ...del. bet. tags; remove tags; print end GETNUM() ...get no. lines to delete->HL; default=1 PUSH R3 FNDPS0(); PUSH R7 ...find pos. in buffer; save beg. of line CHRPOS() ...get rows in line-1->RH0 ...RL to use for IMAGE file (RIO) EOFCH~ EQU 01A ...CPM eof char. EOF~ EQU 0FF ...RIO eof RELOENTSZ: EQU 6 ...size of reloc. table entry RELOTBSZ: EQU 01600/RELOENTSZ*RELOENTSZ ...size for relocation table (must be mult. of RELOENTSZ) ...system cmdnter number in hex\nӫp_Zj2  ``EE!XL F G9Program to configure EE editor for different terminals.\nF GGBoth screen function codes and keys for cursor movement (+delete key)\nF Gmay be changed.\nF G\nF :-1; PUSH R3; NXTLIN(); POP R3 ...go to next line end PUSH R7; FNDPOS(); POP R7 ...get BUFPOS; DE=next BUFP0 end if FNDCHR() not zero then begin PRSCRH(); RET end PRSCRN(); RET ...get new cursor pos.; print out FIND: ...search for string takenhexcode{35C20008BD507F40A0DEC600A137} /* LDL RR2,RR12[8]; R5:=0; SC 040; RL6:=RL5; RH6:=0; R7:=R3 */ errno=errno_; return(retval); } creat(name) char *name; { register int errno_,retval; hexcode{35C20008BD507F40A0DEC600A137} /* LDL RR2,RR11 RL0:=CRSROW-RH1->CRSROW->ROWNO ...1st row of line CRSCOL:=0; R1:=0 POP R3; POP R7; PUSH R3 ...HL=beg. line pos.; DE=no. lines to delete while R7<>0 and CPB @R3,#EOFCH <> do begin ...go thru buffer counting lines until n lines or EOF R7:-1; RLs: OPN~ EQU 0 CLS~ EQU 1 RD~ EQU 2 WRT~ EQU 3 ...note: enter segmented C: PROC; CALR START C0: CALR START0 ...entry point when first loaded (looks in sys. cmd buffer) CVERS~ DEFM 'C VERS 1.00 ' ...C version no. (11/18/82) LVERSN~ EQU $-CVERS ...the folG=Do you want to change screen function codes? (enter Y or N)\nF G DEF G\n YY^ d F G*The following screen functions are used:\nF G clear screen\nF G, clear line (either all or past cursor)\nF G! PIP A:=B:C.M PIP A:=B:CDATA PIP A:=B:CBAS PIP A:=B:CSUB PIP A:=B:MACDEFS PIP A:=B:CFLOAT PIP A:=B:XSUB PIP A:=B:CGSUB PIP A:=B:CGPUTS PIP A:=B:CODEGEN PIP A:=B:XXC PIP A:=B:CBUG  :PREPROS PIP A:=B:CDECL PIP A:=B:CX PIP A:=B:CMAIN PIP A:=B:HOJOB.M PIP A:=2[8]; R5:=0; SC 040; RL6:=RL5; RH6:=0; R7:=R3 */ errno=errno_; return(retval); } close(fd) { register int errno_,retval; hexcode{31C300087F41A0DEC600A137} /* R3:=@RR12[8]; SC 041; RL6:=RL5; RH6:=0; R7:=R3 */ errno=errno_; return(retval); } 0:=CR; CPIRB RL0,@R3,R1,EQ ...find beg. next line end R3<->R7; R1:=-R1 ...no. of chars. to delete->R.BC SHFTBK() ...shift file past deleted lines back; update ENDDAT POP R7; PRSCRC(); RET ...print out MOVE: ...move (& delete) text bet. tags or on lowing is initialized ram: CPRMPT: BYTE '-' ...compile-mode prompt DPRMPT: BYTE '*' ...debug-mode prompt IPRMPT: BYTE '~' ...prompt when in middle of imm. execution stmt SCBFLG~ BYTE 0 ...bit 0: 0=brks not set->Y, 1=brks->Y; ...bit 1: same for SC's FPU insert line (not necessary)\nF G position cursor\nF GCCodes for screen functions may be either characters or characters\nF G2preceded by a lead-in character (such as escape)\nF GF(`pos. cursor' will then have 2 more chars. for tion, base; long value; char *cp, buf[25]; /* NOSTRICT */ argv = (char *) &i; len = length(frmt); while (len--) { if ((c = *frmt++) != '%') { putchar(c); continue; } /* format specification */ /* pick up type */ if (len == 0)  read(fd,addr,len) char *addr; { /* assumes 1st reg. var (errno_)->R6, 2nd (retval)->R7 */ register int errno_,retval; hexcode{31C3000835C4000A31C1000E7F42A0DEC600A137} /* R3:=@RR12[8]; LDL RR4,RR12[10]; R1:=@RR12[14]; SC 042 RL6:=RL5; RH6:tagged line if omly 1 tag ... to right above current line ...if a filename given, move to the file instead TAGFLG==0; JR Z,ERR6 ...chk if tags present if TSTFNM() zero then begin ...test if a filename given FNDPOS() ...get BUFPOS TAGRGN(); PUTTRM~ WORD OUT_RL ...available space in buffer FPUTNX~ WORD FPUTBF ...next free location SEGMD: BYTE 0 ...0=do code for non-segmented mode, 1=segmented NCDFLG: BYTE 0 ...=1 if SAVNCD is valid (ref'd in CGSUB) DBGFLG: BYTE 0 ...=1 if in debugger (SAVSP ishe X & Y positions)\nF G\nF G8Below, enter all values in hex followed by a :\nF GF(in each case, an example value valid for an Infoton 200 terminal is\nF Gshown in square brackets)\nF G\nF GFIf any function req  break; /* end of string */ len--; c = *frmt++; fwidth = precision = 0; /* check for possible width specifier */ if (c < 'A') { /* if (c == '*') fwidth = *((int *) argv++); else */ { cnt = atoi(--frmt, ++len, &fwidth); f=0; R7:=R3 */ errno=errno_; return(retval); } write(fd,addr,len) char *addr; { register int errno_,retval; hexcode{31C3000835C4000A31C1000E7F43A0DEC600A137} /* R3:=@RR12[8]; LDL RR4,RR12[10]; R1:=@RR12[14]; SC 043 RL6:=RL5; RH6:=0; R7:=PIP B:=A:PREPROS PIP B:=A:CDECL PIP B:=A:CX PIP B:=A:CMAIN PIP B:=A:HOJOB.M PIP B:=A:BASICIO.C PIP B:=A:HOJOB.C PIP B:=A:YLINK  PIP B:=A:YLINK  PIP A:=B:HOJOB. valid) NOTASCFLG~ BYTE 0 ...=1 when doing non-ascii file DEFSP: WORD 0 ...use for SP when do immx. nonseg. on diff. seg. FREE: WORD STACK ...RUNSEG: WORD 0 ...gets set to seg. where code to run CDPTR: LONG CDPTR0 NCDSEG: WORD at CDPTR ...gets set to uires a lead-in, enter lead-in character, else 0:\nF G4 Example: if lead-in character=escape, enter 1B\nF G [00]\nfn F GHIn the following, give code for the function plus set high bit (bit 7)\nF G"if it needs a lead-in charmt += cnt; len -= cnt; } /* check for precision specifier */ if (len == 0) break; if (*frmt == '.') { frmt++; len--; if (len == 0) break; /* if (*frmt == '*') { precision = *((int *) argv++); cnt ,1EΕv&18 0d!B8 33!33o103baQoS +3Ε5P@7c3sΕ5P@7c3sto be del. R7:=TG2POS; R1:=R7-TG1POS ...R1=len bet. tags PUSH R1; SHFTBK() ...shift back file over deleted portion POP R1 ...len. deleted if R3:=BUFP0TG2POS then begin ...if TG2POSBUFPOS ...BUFPOS=BUFPOS-len. bet. tags end else ...if TG2POS>=BUFPOS if R3:=TG1POSBUFPOS endif ...if BUFPOS bet. tags, BUFPOS=TG1POS endif end else begin ...if BUFP0>=TG1POS R7:=TG2POS ...R3=BUFP0 if R3>=Rmbols: MAPCMP: WORD 0 ...each bit compared with bit of TYPE word MAPMSK: WORD 0 ...if bit=0, don't care about result with MAPCMP MAPBEG: WORD 0 ...lowest valid value MAPEND: WORD 0FFFF ...highest valid value RELOTB0: LONG 0 ...gets base of relocationPIP B:=A:C.M PIP B:=A:CDATA PIP B:=A:CBAS PIP B:=A:CSUB PIP B:=A:MACDEFS PIP B:=A:CFLOAT PIP B:=A:XSUB PIP B:=A:CGSUB PIP B:=A:CGPUTS PIP B:=A:CODEGEN PIP B:=A:XXC PIP B:=A:CBUG  :PREPROS PIP A:=B:CDECL PIP A:=B:CX PIP A:=B:CMAIN PIP A:=B:HOJOB.M PIP A:= goto unsigncase; case 'x': base = 16; /* goto unsigncase; */ case 'u': unsigncase: value = *((unsigned *) argv); argv += sizeof(unsigned); /* *((int *) &value) = 0; */ goto numeric; case 'X': base = 16; case 'D':: %/^¡ ^ȡ5P[b$PF +3:333 Abb0&⡳0;3473b1S&1S; ^Ȕb +3 .'b$PF5P[ ^ȫb⡳347.31S;b1S& ^ȡ57 then begin ...if BUFP0>=TG2POS R3:-R1->BUFP0 ...BUFP0=BUFP0-len. bet. tags W.BUFPOS-R1->W.BUFPOS ...BUFPOS=BUFPOS-len. bet. tags end else begin ...if BUFP0 bet. tags R1:=TG1POS->BUFP0 if R3:=BUFPOS-R7=R7 then R3<->R7 LOCPRT(); RET end GET: ...get a file, inserting above current line RL0:=@R7 &UPCASE=='E'; JR NZ,ERR6; TAGFLG==0; JR NZ,ERR6 TSTFNM(); JR NZ,ERR6 ...get filename FNDPSB() ...get BUFPOS + value = *((long *) argv); argv += sizeof(long); goto numeric; case 'd': value = *((int *) argv); argv += sizeof(int); numeric: cp = buf; cnt = cnvt(cp, base, value); break; case 's': cp = *((char **)argv); argv +P[b$PF +3::383!3!#"71(!3"73(!#*71(475135763s47"57\3(5ɩ3W"7𔂩3(5٩3G137𔂩1(52POS R1:->BUFPOS ...then BUFPOS=TG1POS else R3:+R1->BUFPOS ...else BUFPOS=TG1POS+(BUFPOS-TG2POS) endif end endif end endif FNDCH0(); PRSCRN(); RET ...find row corr. to BUFPOS->CRSROW; print scr. FORWRD: ...if no. given, print scree******************************/ static char _BUF[144]; /*BUFLEN=144*/ static int _BUFIDX; static int _RDCNT=0; getchar() { /* assumes 1st reg. var (buf)->RR6, 2nd (rdcnt)->R8 */ register char *buf; register int rdcnt; buf=_BUF; if ((rdcnt=_RDCNT) R7=pos. & ROWNO=row at beg. of line GETFIL() ...read in file if zero then begin R7:->BUFPOS; CRSCOL:=0 ...for printing (beg of read-in text) CRSROW:=ROWNO ...adjust cursor row end PRSCRB(); RET ...print out (BUFPOS=start of new text) ERR6: = sizeof(char *); cnt = length(cp); break; case 'c': cnt = 1; cp = (char *) argv; argv += sizeof(int); /*# ifdef Z8000 */ cp++; /* byte passed in odd address on Z8000 */ /*# endif */ break; default: putchar(c); cont  $P77/i0 o怠 x^ u^ X悠 D恠 d愠 f枠 s泠 c澠ˠ13 11S1311S 15P3! /H15P335$P7 +3/]^Ε s͠ՠ ! b3&09  ^h  !ԏ8Ε5&1 8:ԧ9           08b$PF.-ҡ9 bU.-Εat Echo(RL0:=8); Echo(RL0:=' '); Echo(RL0:=8) ... until RL1=RH1; R3:-1 ... POP R7; RL0:=8 ... end else begin RL0:->@R3; R3+1; PUSH R0; Echo(RL0:); POP R0 end ... until RL0=0D; ... RET Outmsg: PROC ...put to file if open + console (save regs>=R4 exc FPUTBF+170 IMGSZ: LONG at MGKNO+2 BSSSZ: LONG at MGKNO+6 SEGTBSZ: WORD at MGKNO+10 E_PT: LONG at MGKNO+12 HDRFLGS: WORD at MGKNO+16 RELOCSZ: WORD at MGKNO+18 SYMTBSZ: WORD at MGKNO+20 HDRUNUSD: WORD at MGKNO+22 SEGTAB: ADDR MGKNO+24 STACK: DEFS 080 ...uv4vVa1EUSU/%a5PoaT5PoT^ΕgaT ,\43` --- ALL SOLUTIONS HAVE BEEN PRINTED --- 4_ΠΕZlvh5&5 (bQΕ5(571  5$PH!-.-5D$B74&b51 BB O @@0.-1  b +3 9b$ MUV.-b$PF51 DB"O 1@7"(376c  c  c  7c  3c  /c +c -17c acߡ6c Xc06  c661J@eJB(16Ǡs D$B(5 $cΕept R7 inc'd) RL0:=0D->@R7' ...put CR in buffer Outbuf: PUTFIL() ...put to file if one open Putcon: PROC ... print from ^BUFF to R7 R3:=^BUFF; RL1:=0 while R3scanf connectmovemnspace2mnavail4stateTcountVhistoryVpathpROM: ADDR $ ...****************** ORG RAM ...uninitialized data: ...following table sizes may be adjusted ... (also RAM0 (=end of symtab & initial addr here) in C.M) BUFSZ: EQU 0C00 ...size of local buffer pool (CSUB) CGTABSZ: EQU 01600 ...size of C %c %c %c %c %c 4;/֩3/3 ?/3 ۩Εa2 ran out of free space -- abort 4!va2YS&a25Po2b1/%b1 3%b5PUTBF+3 ...reversed record len.-actually word (NOTE ODD BNDY) FPROPS~ BYTE at FPUTBF+7 ...file props. E_ADD: WORD at FPUTBF+8 ...entry address (reversed) SegDes: ADDR FPUTBF+28 ...start of segment descriptors SegSegs: ADDR FPUTBF+80 ...start seg. port DATA1 SAVNCD: WORD [1] ...saves NCODE when doing imm. execution SAVSP: WORD [1] ...saves SP from in Debug (used by Err) QSEG: WORD [1] ...gets seg. Q running in BRTNSV~ WORD [2] ...saves value in system BRKRTN EQUVAL: WORD [1] ... 0 ...value of equatpathlastchar bposprt printit Vnewmnode getnbrinstatedinitlistpath*dejavuwin,mainTED --- 4_ΠΕZlvhGTAB (CGSUB) AREFTABSZ: EQU 0600 ...size of AREFTAB (CGSUB) OUT_RL~ EQU 0200 IN_RL: EQU 0200 LINEL: EQU 080 NLVLS~ EQU 5 ...max. #levels of /DO's MAXFNML~ EQU 32 ...max file name len BUFFER: DEFS BUFSZ ...local buffer pool (CSUB) CGTAB: DEFS CGTABSZ   7$bΕ36` 3  3=203 003 9 03  3&203 003 9c 0U0S6.20n cΕ! enter initial configuration as list of positions without ion of seg. descriptors LO_ADD~ WORD at FPUTBF+110 ..."LOW ADDRESS" HI_ADD~ WORD at FPUTBF+112 ..."HIGH ADDRESS" E_SEG: WORD at FPUTBF+114 ...stack size (used for entry addr seg) ...end of attributes SDesPs: WORD at FPUTBF+116 ...pos. curr. segment de kept for listing EQUFLG: BYTE [1] ... 0 ...set=1 if value of equate to be output when listing MAPTYP: BYTE [1] ...'A'=>do Map alphabetically, else by order of occurrence LastNm: WORD [1] ... 0 ...last name put out by Map Nxtpos: WORD [1] ... 0 ...next ptchar(); while (in_c == ' ' || in_c == '\t'); while (in_c != ' ' && in_c != '\t' && in_c != '\n' && in_c != -1) { if (maxcnt != 0) { --maxcnt; *strp++ = in_c; } in_c=getchar(); } if (maxcnt0>1) *strp='\0'; return(in_c); } static inputnum(base, ...code gen. symtab (CGSUB) ...WORD 2+2*NCGHASH ...for len ...WORD 0[NCGHASH] ...--entries-- CGTABEND: AREFTAB: DEFS AREFTABSZ ...table of addr refs (CGSUB) ... used to delay label addr def'n & shorten size of addr refs if poss. ... smaller tablepegs: 4֨16c c5PVv4eUSQ/%?oTО63c aT5PoTv4eUSU/%Ε!+o217s [s07vuYSD$36c Bc064u SeUS!#83+escriptor (used with IMAGE) RGNSEG: WORD at FPUTBF+118 ...runseg & ncdseg (hi/lo bytes) of image region SegSegs2: ADDR FPUTBF+120 ...where segs. to image from stored ...below is for header: HDRSZ~ EQU 24 H_SEGT~ EQU 10 H_ENTRY~ EQU 12 H_FLG~ EQU 16 MGKNOos. in buffer (used by Map) XAdd: WORD [1] ... 0 ...addr. to execute at (used by Debug) SYSSP: WORD [2] OUTLVL: BYTE [1] ...=LFIL if output file=list; =LFIL+1 if=image LUS~ BYTE [NLVLS+2] ...store LU# corres. to each level input or output file ...FILNMvalp) /* input number of base base to @valp */ /* ret. last char. input */ long *valp; { register in_c,sign; register long value; value=0; sign=0; do in_c=getchar(); while (in_c == ' ' || in_c == '\t'); while (in_c != ' ' && in_c != '\t' && in_ means less addr refs may be optimized DATA1: DEFS IN_RL ...low input buffer DATA2: DEFS IN_RL ...high input buffer FPUTBF~ DEFS OUT_RL ...file output buffer ... also used to store file attr. + misc. for IMAGE cmd. FTYP~ BYTE at FPUTBF ...file type4ơ SeUS!#93vuYS/塅3vqD7h$$訠!Xn ܃3o36c c06vVeSU.-Ε16caS9c06c  =/_%d->%d 4~ WORD at FPUTBF+150 IMGSZ~ LONG at MGKNO+2 BSSSZ~ LONG at MGKNO+6 SEGTBSZ~ WORD at MGKNO+H_SEGT E_PT~ LONG at MGKNO+H_ENTRY HDRFLGS~ WORD at MGKNO+H_FLG RELOCSZ~ WORD at MGKNO+18 SYMTBSZ~ WORD at MGKNO+20 HDRUNUSD~ WORD at MGKNO+22 SEGTAB~ ADDR MGKNO+24 SL~ BYTE [1] FILNM~ BYTE [MAXFNML+1] ORG $+1&0FFFE FILPOS~ WORD [2] POSTBL~ WORD [(NLVLS-1)*3] ...store inptr & file pos of lower level inpt files XSP: WORD [1] ...SP when start execution (also uses next word) GO_PS: WORD [1] ...4 word prog. status blocc != '\n' && in_c != -1) { if (in_c == '-') sign=1; else { if (in_c>='a') in_c &= 0xDF; if (in_c != 'X') { if ((in_c -= '0') > 10) in_c -= 7; value=value*base+in_c; } } in_c=getchar(); } if (sign != 0) value = -va F_RL~ BYTE at FPUTBF+3 ...reversed record len.-actually word (NOTE ODD BNDY) FPROPS~ BYTE at FPUTBF+7 ...file props. E_ADD: WORD at FPUTBF+8 ...entry address (reversed) SegDes: ADDR FPUTBF+28 ...start of segment descriptors SegSegs: ADDR FPUTBF+80 .vVeS!#3vVeS1#3׷ʠ=/_Ε36?8  5PXc3v4!EUQSUS5S61eJE37c*6vVeS +u3S31 vVeS$ MqU.-3GENTSZ~ EQU 8 ...size of segtab entry ...segtab offsets: SG_ADDR~ EQU 0 SG_LEN~ EQU 4 SG_TYP~ EQU 6 ...bits of HDRFLGS: NORELOB~ EQU 0 ...set if no reloc info/symtab RELOSEGB~ EQU 1 ...set if may be relocated by segment (use seg. of E_PT) STACK: DEFS 0k used when starting execution: GO_PSFC: WORD [1] GO_PSPC: WORD [2] RSAV: WORD [3] ...save regs during ret. from or starting immx. SVQSP: WORD [1] ...save Q SP when do immx. RAM: ADDR $ ...**************** ORG ROM  gs during ret. from or starting lue; *valp=value; return(in_c); } /*********************************************************************/ /END SECTION /* get rid of static symbols */  hexcode{31C300087F45} /* {R3:=@RR12[8]; SC 045} */ } /***********************************..start seg. portion of seg. descriptors LO_ADD~ WORD at FPUTBF+110 ..."LOW ADDRESS" HI_ADD~ WORD at FPUTBF+112 ..."HIGH ADDRESS" E_SEG: WORD at FPUTBF+114 ...stack size (used for entry addr seg) ...end of attributes ...SDesPs:WORD at FPUTBF+116 ...po18 ^ 5PXv4US!# ^zvYS"&b(^zb5"&v4d1EUS!# ^tv4d!EUS!# {v4d1EUSv4/A/!v4d!EUSQ/%Dž3v4d1EUSv480 ...user stack (variable length char. strings) DBGSTK: DEFS 0C0 DBGSP: MYSTAK: DEFS 0C0 ...reg. stack MYSP: ...top of stack BUFF: DEFS LINEL ...output buffer FTYPE~ BYTE at BUFF ...where type of input file returned SEGDES~ ADDR BUFF+28 ...start of wh!31/47 8 w5$p!31/47)8 [5/%V4!3߇8 G4Ц$$;1313ߤ8-?+ X枠 D杠 x氠 h毠 d檠 f湠 ckspace ... RL1:+1; RL1:-1; JR Z,GetN ... PUSH R7; RL1:=0 ... repeat RH1:=RL1 ... if RL0:=@R7=9 then begin ... repeat RL1:+1 until RL0:=RL1&7 zero; RL1:-1 ... end ... R7:+1; RL1:+1 ... until R3=R7; ...get RH1=col. of prev. char. ... repes. curr. segment descriptor (used with IMAGE) ...RGNSEG: WORD at FPUTBF+118 ...runseg & ncdseg (hi/lo bytes) of image region ENTRYPT: LONG at FPUTBF+116 SegSegs2: ADDR FPUTBF+120 ...where addrs. to image from stored ...below is for header: MGKNO: WORD at/A/!v4d!EUSU/%AaT5PoTa5PovVaSd1E3%vVaSd!E3%vVaS/%aT 1Z^^>^a 3Iv4vVa1EUSv4vVa!!/A/!  w*PPw*Y VERS 1.00 -* `P5`n LP`P5 jP5 s `P4!P7r{Y5 LP4ALP4!_Z***** P6 4 0_QP OVER NESTED 5!e!Ը#.xp8bP6e` 堉bP6!^\Ԯq1aP1p.xpoP1poPCaP0 9,/^\ !7qsG3 a _`QM@Eqqo_[.ө8` 1p+.xp_[ Tw@_[%_[ߚө _[ߥީ _[R0 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10R11R12R13R14R15 N4 FC_[DwD!BU x '' ""p q""p"PTOO LONGo x  p xaC.{p 8   ,, 80 80 AA#8 uHHp00 99.xp(00 99.xp..xp+~ӞЉu q^^_Y^anЯ sy x ++ -- && ||pw#9 x ** //pw Lթվ .xpa!v 41a11pCMP_v 00oP$a-_Z ERROR _Z -NOT FOUNDa- H 901pR !hP3aP&LP!o .[[ !s09p?.xp-[aP$oP&LPФLP5a! tpJqs 8 KK1p? ^^11// ~~0 &$ ++B --B &&SB ||SB **@ //@K.xp0贫p {p sp zp rp.rp.zp.sp.{pjЮ^\ߧߟߦ_gb߭w!S#/CCBz  @1p=.xp_[   _[..xp_[ Tw!Oߚߨ_R     _Rܗ ߹_Rܫps   '  ݄_e.H_[d u po! .xp(PONеH!100 80<fP4^;ԧ u ! 80 ==a xpaPۂ_gbrqTP" '' 8̩0oP$0 80oP$!1aP",4a CC5Œ ^] LP !KP տ.xpM^te^_YDpC _YLsmf_Z p_Zjфvalue( QݎU q))pw|вR_Z$p_Zj Х Pђҥ/򂪞/aP"^c&ejoߔ q paP$oP&!LPa߷^q! }2?}:]      ;;ʽ x   ;;!  ! }2?}:]!_Z/DO !ogP"oP"oP LP5   騐      #ߵE։+Y^Uf( _k)U#_[v=#-_e}܁܄;[܉;?ܐ~n P2ܔܗ:_ܛܞ;_ܦ/ܩ*s q شsܶDO LܽLOAD LēڻW_UpPACK ALLTws_Yx_Y s xp_R$).38<!|,s ?!ssG4B(X ppSC _[ "CALL 9_[ž_Y_[_[1 !aȗ}} C_ a30C_aP LP ; JJ"ꠀ0 ^]> a`0ނ^D AA^^Z 80 11% 334 LLL 44.1a߰SsTS ލ0߲1s]sqJ aɡS0mS҅_VZfP4waPL_Zդߕ$_Qn[!]տLP0 q//E q p K H_[H_[,֍ ֑ *L֖%,#(8;...2>J081:>5:LW.cRB.iX!4Ps  x  psL NP0.80Z  Ԟ .xp!s 8j0@ ??  L ??   ѐP^ݞfP4E!ss1aPaPoPaPs1ңҤIMAGE" xp    p_S!oorMtޯޱ05AW_Wnm EOF_USTART e_X>BRKS-> !Y_Xt'P-RESET03EXTEND ӯ;CLEARCSEGLPKNONSEGLPTMAP x0h$ h㠉q&nb03}} Tw8_Yaw@1 &߹!߾s_Y/qs1o6З2.8!_Y*_Y !v5!0 &354 5a0B!_Y*!vh 7 \ aۡSsހSڽ01s0ҧґpwTޘDC@SB޻ _QP MIXED REFe] HHѓю OO ќї֞ WW Ѩѣѥs֩q RR& 80ў01s 11N^] 440^]s 339^^.n q EuabWWageaP$aP TP"B_Yb_Y*qQ boP$!^_Y*1LPA_Y*1Q_Y*1aP"O@aP OAS0at.M@.E@.K@.C L itIP/A(/@p s!oPfP4!CPMP!oPa`LLP4_QWRITE`LdP4n߼!6` "(`P5c!!!Bء7 ^VcD4!u߽0 1` AApnuҰbZAP d;gגچUqLISTtwOFFbP4~ON?_P݆END GS_T\݅_XְۆݖIF ٠ݜTHEN݈n P0ݤELSEBP0nP0ݰENDIFLP0ݹWRITE 6ݿ,:ݻߞGLOBALDIAGJ83359!v!0 _[52_[y5_[<=>?z|} {{ { { 96.,(*   &$":;0123457pqrstuwTw@_Y a ֞X   d `^`*^] DD ٠۠ݠߠ LLaP 9ec57<J . > Vt5 sl0sSF;GLDDS  K_QPREDEFINED LABELsǭs}z^`*s߸s0}a_ae_`ߨ e q..ECa_Y q::p_`_` _`        x [[ (((_`._`  _`_`a_a<׮_a_`G׳_a!_P54jP5_QOPENaF !1p.{ {p {u5  ;,<>=* !! ~~ !U2TEU 8  0P` P5 ^dhP5!ҁpT /g7bДD]LP3L aPNҷ !q^TL  dP4*_P^/_XZMP,MP.TMPS@UNDEFo0s!oP(=oP*R=܅oP,,܌oP.aP,oP.޿ 2ALLL͞ { 00 zz odP4LMJX ovܯ)ܲ>a`!~8!4VP {ߒ!~J!4P?? ^ g!~^4 99. P!~f4 ' PP??!~k49S!~q4GSP!~}!4VP Pv0t1wqt1awDB_QP OUT OF RANGE9_QP ODD DISP. 008820s``??`n`ao`R׽Rg100 ȋca8 x  %aL aP&a_YoS_[aL  U_[_[L_P,aP&KP$&! Q Pu u p @@ u[[p | _X_[0KP$].xpp_[7&11$.}2^TLPߓ!^Q`P3 !_Z ERROR TOTAL=9Z!P5 X*PLP Y !ҁ!g5d]LP5LPa^"LP5%! q^U q^Uuss0!1Q0TԖ]`PLP3!oo4 9!=GvۮCZ]E=aP orN;o/oravorsvT=Ncr_rBvUݐFރ _Zppލޒ_Shw2  ިEQUݳޕw b޲WORDx eu< ?wBYTEߍ ܣߊ\ _aw:3Vaw:gw>aw8_Y1_YXjر Y W `waw0Q ߥߩߙXٲawgw>Tw1_Ygw> 1_YٲAwQ`oTc     E_QP NOT DEFINEDLP 8 AAa!PJoMU QP7 x   ,,p ߗ!1שs7/7qo 808aPFsQP6Xu5 :43=?}:5LPaP$` PaP$oLPaP$LPLPaoP$Հha!uƕoP$n PaP"5/]}2LP?oaPKa7]oaov}2?}:5Dya]v_\3}2?}:1^ ɞ2_QREAD! U!Ae hX@b5j i afa3 5aa˩!71!11ߴMrߵߦMara;]/oMMM!! P! ]4!7ooߌLONGߢߍWߚPROC߰ߤߝߧADDR!۬ ߴinŤn! $n( ۠?1 /aP ' Lo>Aat).IARRAYLP2aP$E1gw>1_Y1_Y}}}$}55(}X gw>_YnSaw>Tw@]w&!0bq_Yow  ]wow^LawTwb!_Y*Tw aw Mw Tw@ &s!u X Оaw}Kө9gQp6~gg aPF==שxsSKPHnapppԡC\ӒoCӗ_QPTOO MANY SYMBOLSaPF!11aPF!B/11.80aPF7/7n!@aPF=;( `g ߼L$ @QS_QD_Fԑ$+ReޤRu_ԻFC PCN4ԴvwaLHߍ] o !a!ԗ!!x`s!ba ڕa }T!@} N(T!@}:N0fPE]dPa!"fPbPTPP!P1paP"ߗaP"ߗs p00oP$1]D_[ZaP aP$]_Yas݀ߑ#!݋3ߝ\,ݖ9ߩV8ߛORG߈ߟІߋ_oP$*KP *oP"oP ߻DEFSߩi߬۞DEFT_Z߷DEFM_X??  OTw8gw>bswE _Tw81357 }6377 1 vJ! w 1v>?# p !.}2?}:Tw@Pw^aw00 b2 8*0 8!^B2!1b_Y*bx _nD .xp.xp=_[Fg`ө8Юл-ޡ9naPF1a!1o`  C naPF3=3aaP(IGP*KP.KP,;MLAAa PF BН )ߥ`Mc߳a _SbԣafGߑLwiJߣߊ]w@LwiBߣB߳ߚߋvX߱QXߨJL'߰Tw03,!_Z$_[d_Z$ _[d.=0̞n N߿ 5S 5 pw,  qp ypCaP"aP"q }R_}Z (}R_}Z.(}R_}Z!! }R_}Z/!}R_}Z!`_}Z!1 y0^8rpo^816~o0038'008 :;<=>?@ [\]^ ` {|}~Z'_[.'۩pwAP$oP$gP$zero^YJ^Z^Z^Z^Z^[^\^\^e:^eD^d^e$^Ql0_Zj_Z _ZBCF_Y6A27.XB,.ԉ)HH_[@_YQALR Ҷnaw>\ w^z_nDTw@_[Ԇa_[fjwh^^!`wi ^Tw@ҽTw@]aw>oTw8]\ w^v7u3u}B?1u# p !.O}JaT^o}2oaw8?K aw:  @?!@SSP" Rem Space=пaPH6_Sb!cC ө8a1o cE x 80p q 1 10p x 8 a`s A_SbMgYZԇ\aԋ`ө81p!sk7 Mp_Sbpo e!3Tw]Ӱ x   ,,Tw@ q,,p"nwh!wi]wՁTw]w_[‘ߨ!P!a_Y6]w 80_[ 80_[_[ |.xp 8   ..xp0 |.xp_[>&!A_cuC  x AA ZZ o!Y`p x 00 8 x 00 99 op  AA FF aa ffS""$%B *WS"'߉%W!!3 >CY- 901p00-aa11p x    p x   Ibnbh2** ei^cx- tx~rߧpЌ$T}Ж' x  p q''pwЏޗЫ$TޛLе(߿Ск)Фо@ ^Ъ}/aP"_Y޹()6  a}:a^vZLP@oP$_r q _Qn! }2oLPE`P_VLwi q//p_g$,SP$0w.9Lwi!,oP$o_gb=H@!nN!}: -DW*-*AKW8000543JTWBD00>=R>?BaOF0LEC*_)XrCLR xCOM~NEGrnӈADC4ӎSBC6_әOUTҰӆӠLDIӓӧLDD Ӛӝ_eӛӵCPIӨӼCPDӯӬRLCӹRRC (ӽTCC_6LWW_t_> SFց5ߧ*LG֐ߘaFoFǞSF ֟Ֆ֦߬K×aF5ؗ SFaFLpLFdG׫݌ݛWC000݁ݘݘ!ݚX ȠݤȡݧݸWݜݡԷ mW0D09YVkT_etӖמL W4000iliniހi~ӪӠ(P+P$< BB^x LL^ ޚ_e* ޤ_e4ޮ_e(> c BB^ LL^1"޿F+W0200== p == >> <<dAPPCaLq--Lq>>_o_f_d_ xp ]]_et q((_t߾ ۽؈W0C01_؆opw ؈_etؓ|Ȁؖ{ بW0C04_ئ؏س҅O^$I_LPߢWߧB߬L߱Q)ߺ'#+ LP4 LP<٤Cap x00  p x00 pLP1 qRR_m _m 6 qRRL_LDR-ޞADD __ SUB __ׄSLA SLL_(SRA .SRL_9SDA ?SDL_0JBYTE_m _mҪVWORD_m6^PUSHa MgPݠݵ} ߭߈ߴ ߉ߺX ߐ] !! ߸_et0ƞ  ߤ-՞͞ܞ_R _e8_OC03_ȗ __W2000_'W" _et_Ξ_etŞ0O؞_X5anj'y_p$W1C09 * $W5C09 ! K0W1C01- ;W5C01#8 #՗Lմ^:ҵ<TfB3D BB^ LL^_o_et_fX_rdE x ++ -- || &&.XOR.<->М x ** // %%_rL_ep_YАӣ^  Ğ_rd  T 3 aP _et_rdaP _rp6["+g_t _`8  p x LLF ﲨ HH P 蘒B RR\L QQfQ oW.W,7O_e%4>O*_e;_fHR.xp_[CLLLLWWLLLLS x OPLjVpLONG_mLxCALR{gr^ԄCALLԇy{wԑLDARԔ4Ԇ_nԃՔԅԟMULTԓYԏԩDIVLԝ[ԙԳIRETԪ{ԼDJNZ Կ_tԬնԮW_֞LDPS_W3900Ը _zW7900͞L_et_et_et_et_etANߔ@֘ ϞӞ  ! !! ֊קзV,  6ֿ֥_ސW`uތ_ޘWhރ~ޕ~U_ޣWs_etފޡ_{ޥާ_޸Wޜޟ X_.տb h BB^0ԁm߄W8000lol߃ԋ| Ԩߐ> BB^zߛ߫Wߏߒߕߨߨ ߥߧ߽O_eߩ߬߻d BB^߾)WٞՁ C]-ߚ߉Ӣߪ]-ߛߦް?<+ߪߵߠN߲ߴ45n[_`Sb_rdak^ _`q QKٓ]}نوٗW8100قٕמȀٙN!>1P!>0BB LLpm`s#_n{#_n 3o_e8_rdڂڊڊڒ$ڒښڮ#"_n4_rd>_rdF_rdK_rdQ ɞ@6ɞΞDIRLDDR _eXCPIRCPDR (CPSICPSD X $OTIR+OTDR 6INIR=INDR2 .HTSET<֮8RTESTFָB\EXTSJӹePUSHLޞޣ޶֬8ֻ Џ޹0;_:)Н_ȀMSЫ_R_rd_rd _WB200ٞ_Z_b_ש__\__f_WB10A߂_2߇_@SFjGWFw  gBB^ٞ5 ^YJ^Z^Z^Z^Z^[^\^\^e:^eD^d^e$^Ql^ed^e^e^e^e^r BB^ LL^ߓHp 1_rdߘߡ Y|1!_rd+ BB^ LL^߽$rլJ!_rdDӂ7yӆtC ܬ߃0ߺߡܹ==b͊0+h-j 6Wޗ_et_n _f?_etek _W4C08 ` k*W4C05(ߐbЖ@DԞ, Pif$([_etqH_e@д_e-)0]8(;[є'@)C]-6ѻ_n|LPR|_faP _pG_f3K񠓣?_rdhTnMULTLb ^xDBJNZ {_LhrjB_֞ՇCPSIR{ՏCPSDRՃՀ՚LDCTL`ՈգSETFLG՘լRESFLGայCOMFLGժռ)ըճ_   ^eD߈LF`G`GFдл ў  ֞ !!rо h_et2VA_etU׈Ξڞ_sW2000[Z[`_etu)+t_`q{`p~__rd߅_ߋ_ߑ__`aF SCQ0a a x ;; 6Մմ\!_rdV BB^@ LL^6pP՘vЋHoІ ЄВЗ МG BB^СЪйOХ_eШз#c BB =֙; <֦:͞ߛO$ݩСݱ_o#ӊ,يPW6̀(_`oD WW BBԛԚԿdAfAdAoBoFeSnv߫ڮ_r-_r.,4Ȁڭi|SX_o_ra _f/aP _rdn_rp_YۊALۋۂ۔<<_pۂۛ>>ۆ_f?]ۥWۍیۋۢ۬W3000Uۙۘ۫۔T LL^ BB^иۮ۰3۸њ۸"/ї W0D05۾n۾˞5   $               LFLFfGfAEL>L>L>L>L>L>L?fGfGE3MBEaBKFE fCEL ,, .._r x _m F~7ppE (() [[] "" ''  p x  p x  ^YJ^Z^Z^Z^Z^[^\^\^e:^eD^d^e$^Ql^ed^e^e^e^e^r%(,3_rd$& (MF֨աȞֈ BB^C?ָ;Mޞ"h>ɞ:r$ֶ;_e* 0_eI:.W+׆6W2 BBS/ז1_eM9 BQW7D00;<;P^FLAGSpLN @/Ԯ_dwڲ[ڷ@ڿ_< [!_d [҈_rd_eW@ڞՓb()&Lv_o_n_fۃ ^_`_rdխ(W81D0%ъ_n!;":JoѪ W4D05уO!_efo. W0C05 ь- ҄ 2,Ҍn -W4C05*ѫ#2.В 2_ef_e_etKOC069H1LfBD7L.pLNq?L?LpL?L?L?`p`@  LpJ@CL@L@L@`pLF`pLFn!L> ЃLPd adE7Tв3 q00p_Z$qCL@(MM_\(a%wKR)<2\Q_gbU_,߾p> ps->eݠ߽gege_iQ_gdAU_ӈ.Л_8A_R0_rdЧ_!ЫӂckFLAGSW`e4wNSP {OFFlsLPEыSEGv134_._oW_YѡA.ypѣњgP$_QP ODD BOUNDARY x CC ZZ SS PP VVpw_r q E_laPJ_Z_m 08-6D_[_nDL6?6_tKH_[C>W(C\)F`- нLDLAL@MBMHJ!JaHaFʡ4u'\!SӋC!SS߀QZ߇!0!>1P_!>!PД!!fAQ aH JQ'\!!S4` A`BJ@ bAaBߡ5(CS9!S.C!S߮gEe_\_reA2_epл̞g_ лdA_ i_ _@Q U__wa_gag0_rT_lMxL~axo|"->axoz 3_Y""={ ?_B   0 0 BB LLWӞ ^ ^ ^ ^ ^R BBn ^8 ^ ^ ^ BB LLn ^ ^ ^ОJJR LԨLOE09H>3YJPL]ԹդJdEI1V,_nҩҔ2@ۻ_`_rdҴ Þ=ȞDDϞKM'~ߞӓ_rd_eaCձpaaȀf qaaputchar!Egetchar!D%close!A_rd(0read!B8write!C  BB^: LL^RX_et ҇מW0001 W4001 E_et ґӇ1 ӎݤp҃0W,6W!3>W"9 BB^ӚlѮ#YW4000CBGBYBuQC!SQ9CaS`AbA>nACoFQyQk+]q-cw|i }&o܃.XOR.wt܎<-> ,܁n[_et߂܄ܜܟ*ܑ ܥ/ܗܫ%ܝܚ}x֞Z #! BB^0y>4kҎpҏv3ҋUK݂ҥ݇ҦݍJҾ_etݢݶZݹEQݬNZNEݷCULTNCUGE̞PL ӞM #WaHQҋuoHs1aH11poH}aH1oH!3KBdAaH0 JQ'\1!S<ЌaH JQ'\ S1RaH11 oHnonpnq`o``_e 8nr HH0_[rotns_e~_[J_eaAAќѻg_rDaP _[a_[_epJ08ΞaP$oMa_@Ma_@aAAAa۲bP1MP,MP.MP(MP*_sa_a^_ax ; o=ix`~_`_`a BB LL% LWW__mdGRET EOPOP LDMLDA _n_֛"DIV+LDK -__J_9BIT& ?SET$ERES"_6PANDVXOR_GaINC(gD՘ߓaD_rdӨ`Cܺש @ܿaBםȀɞKaaרȀԞ8.߱.C߹_etstkȓ flag!} ג! ޗW_[ stk- +ՏePFߎVfԞ~8 0߽ӐՉՌFIڞOVPENOVPO GE  LTGT LE  UGT 'ULE~O! '<W4000$'*%<%ƞ>Զ  dqKwm_[J`oLrHHat_e~ 1HH0_[r`GJqE_e~$&񊘍ELqE֞'3`sȨ ȪLs..LsLs Ls Җ3 Lo VҤ?1󪀞ҹU_ x ::p q  QQ%%o@!A|azC|ߝoߠo!AzaxCzaa!]Q_`_@@C_`@ @@@CCCo!a| !o!ooQa=o 8AA_Af!A|azC|cff!]Q_`0 1`P5>jP5_QOPENaF !1p.{ {p {u5  ;,<>=* !! ~~ !UFTEU 8 0P` P5 ^dhP5!ҁpT /g7bВD]LP3L aPNҾ  cmd buffer) YVERS~ DEFM 'Y VERS 1.00 ' ...Y version no. (11/17/82) LVERSN~ EQU $-YVERS ...the following is initialized ram: CPRMPT: BYTE '-' ...compile-mode prompt DPRMPT: BYTE '*' ...debug-mode prompt FPUTRM~ WORD OUT_RL ...available space in buffernCOutset"Ԟ*CCopyin"#1"CGenn0.DO( 3_7:;?))_[ACCopy=_nM"H_Z$_[p x )) ,,K eJ0EXamL_h__q x ;; // )) ::p xym table addr for func. params & variables RAM: ADDR $ ...**************** ORG ROM ********* ORG ROM *** ORG ROM * OR.save regs during ret. from or starting immx. SVQSP: WORD [1] ...save Q SP when do immx. PVARTAB: ;WORD [MAXNPVAR] ...saves sC_0_`AaaM 3M5M1ܐ x )) ,,n Cp_begin_qendif_ then_q__q _rendif while_`_)do_q_.J08+"_r<repea!u^TL^TLPߗ!^Q`P3 !_Z ERROR TOTAL=N6z*LASTCRLASTDECNEXTDETP"NCDSEGKP$NCODEPFTABBSEPJEXTADRdPJEXTENDPLUSERCCvo`oTc     E_QF NOT DEFINEDLP 8 AAa!PJoMU QP7 x   ,,p ߗ!1שs7/7qo 808aPFsQP6Xu5 :t_`_q.E1Kcase aҭ_qTof?YendD^until$_qL__e_t_rTY_RBW___e_taP _rZm_lp_rӍelse߬_q_r_qӛJ08ӆ_epӉӚ_r_q%ӬӯorӯJ06ӢӫӶӢ_rӻJ ɞ5_QREAD! X!Ae hX@e5j i afa3 5aaӂ˩!71!11ߴMrߴߥMara;]/oMMM!! P! ]4!7ooFLG~ BYTE 0 ...bit 0: 0=brks not set->Y, 1=brks->Y; ...bit 1: same for SC's BYTE 0 DEFSP: WORD 0 ...use for SP when do immx. nonseg. on diff. seg. FREE: WORD STACK RUNSEG: WORD 0 ...gets set to seg. where code to run NCDSEG: WORD 0 ...gets set to segPQuitN[OuthexQPErrmSbOutmsgLSjPutconTVZGetrecOVGetconЂYId&Z DigitZ$HexdhZBNumZjHNumFZR#Latch[.Cnt[dOutpetIgaLkupaLkupnl43=aw}Kө9gQp6~gg aPF==שxsSKPHnapppԡC\ӒoCӗ_QFTOO MANY SYMBOLSaPF!11aPF!B/11.80aPF7/7n!@aPF=;( `g ߼LJ0E_epӸ:ӰLӷӷ;end^ SF_fWF_qSF_WFMF_MF_aF___R_|_v else_r_q__q__ oF':-1_n"+ q;;1L-$8J$_ere segment descriptors returned SEGSEGS~ ADDR BUFF+80 ...where seg# of segment returned ENTSEG~ WORD at BUFF+114 INSTTYP: BYTE [1] ...type of inst (W/B/L) Hash: BYTE [1] ... 0 ...current hash code used by Nxtsym Link: WORD [1] ... 0 ...by Nxtsym: link. where code put out NCODE: WORD CODE ...current spot for code to be put out (must follow NCDSEG) LSTNCD: WORD CODE ...NCODE at beginning of line ...next 4 words used by MAP,ZAPALL,PACK to mask symbols: MAPCMP: WORD 0 ...each bit compared with bit of TepPpOfASMSTgCOMMANDfLABELCOLqXCOMM INSTYJ#TestZZ#DelZ~#IcopyZ#Copyin@Z#Copy[*#Outset\#Out\#OutNGe:#SaveD#SavBAd#Gene$#ZpQl$$ g`ө8Юл-ޡ9naPF1a!1o`  C naPF3=3aaP(IGP*KP.KP,;MLAAa PF BН )ߥ`Mc߳a et_ep7_r_rNor NJ_et<;_epN'_rcand,}_q_q_f_n"_n_n"ԃnotԅ_eԎcarry߹_n"ԙ<>ԟ=ԓԕ_eԭ<=ΞԳ>=؞Թ>>=̞Կ of cur. entry LASTCR: WORD [1] ... DATA1 LSTLAB: WORD [1] ... 0 ...addr. of last label (not equate) listed DOLLAR: WORD [2] ... CODE ...NCODE beginning of line or instr. LASTDE: WORD [1] ... DATA1 NEXTDE: WORD [1] ... DATA1 SAVNCD: WORD [1] ...saves NCYPE word MAPMSK: WORD 0 ...if bit=0, don't care about result with MAPCMP MAPBEG: WORD 0 ...lowest valid value MAPEND: WORD 0FFFF ...highest valid value Skip: BYTE 1 ...if=0, skip line unless begins with "/" RTYPFLG: BYTE 0 ...set=1 if have symbols of#Err0ed#ReEe|#Xc0e#WRe0Oe#WRe4e#WRe8afa3 5aa˩!71!11ߴMrߵߦMara;]/oMMM!! P! ]4!7oo_SXԣ Rem Space=пaPH6_SX!cC ө8a1o cE x 80p q 1 10p x 8 a`s A_SXMgYZԇ\aԋ`ө81p!sk7 Mp_SXpo e"<<=Ξ>>Ϟ<<><̞_e ՞_e ޞ_e _e?' $CF\nT qaastop"printf(_Z''_[.) pP M8)"Dӯd  ODE when doing imm. execution SAVSP: WORD [1] ...saves SP from in Debug (used by Err) QSEG: WORD [1] ...gets seg. Q running in BRTNSV~ WORD [2] ...saves value in system BRKRTN ...SCRTNSV: WORD [2] ...saves value in system SC_RTN ...FILTYP~ BYTE [1] . REG type SCPFLG: BYTE 0 ...used by LABELCOL NUMERR~ BYTE 0 ...error count DIAGSW: BYTE 0 ... bit 2=1 for file writing ... bit 3=1 for diag output ... bit 6=1 for listing INLVL~ BYTE 0 ...level of input; 0=>from console, 1-5 =>from file TMPTAB: BYTE 0[1*SEG *CALR $+2;POPL RR2;LDCTL NSPSEG,R2; R3:=TABBSE;LDCTL NSPOFF,R3 /IF begin LDCTL R3,NSPSEG; R3==08100 end THEN ORG 2.05000 /ELSE ORG 1.05000 /ENDIF *NONSEG /CLEAR ROM: ADDR 05000 RAM: ADDR 0F000 ORG ROM *DO ZRAM *DO ZBAS *DO ZSUB *DO XX.Z *DO ZBUG *D!P6 4 0_QF OVER NESTED 5!e"!Ը#.xp8bP6e` 堉bP6!^\Ԯq1aP1p.xpoP1poPCaP0 9,/^\ !7qsGP1ӭDsave=2MrestoreG<Wsetseg O}3} gresseg_-} sreturn y(_gb~)hӵՃcalx Ն_Ys~ՋALՌՇՕpatch$c՛r__qՎ0$ժ[ _Z ՗՞շ]աՔգ_ss..type of input file (bit 5=1=>ascii, bit 7=1=>proc.) EQUVAL: WORD [1] ... 0 ...value of equate kept for listing EQUFLG: BYTE [1] ... 0 ...set=1 if value of equate to be output when listing MAPTYP: BYTE [1] ...'A'=>do Map alphabetically, else by order of 6] ...table to mark temp. symbols as used (=1) or not (=0) TABBSE: WORD TABLE ...beg. of symbol table ENDTAB: WORD ENDTBL ...end of space allocated for symbol table EXTADR: WORD EXTEND ...gets addr. of EXTEND when defined, else 1 UCCADR: WORD USERCC ..O ZASM.Z *DO ZXX.Z *DO XMETA.Z TABLE: WORD NHASH*2+2 0[NHASH] ENDTBL: ADDR 0F000 CODE: ADDR 0 /MAP UNDEF ORG RAM *SEG *LDCTL R2,NSPSEG;LDCTL R3,NSPOFF;R4:=08100;if R4=R2 then R4:=08200;R5:=^TABLE;R1:=@RR2;LDIRB @RR4,@RR2,R1 *NONSEG * PACK() *SEG *WRITE"Ty3pJqs 8 KK1p? ^^11// ~~0 &$ ++B --B &&SB ||SB **@ //@K.xp0贫p {p sp zp rp.rp.zp.sp.{pjЮ^\ߧߟߦ_gjn _Zտհռpw_Rռ%B%WўFLwaoF_LhwaF_2` w_rd_W0D09G_n`c__ !%1.. q..^ -1occurrence LastNm: WORD [1] ... 0 ...last name put out by Map Nxtpos: WORD [1] ... 0 ...next pos. in buffer (used by Map) XAdd: WORD [1] ... 0 ...addr. to execute at (used by Debug) SYSSP: WORD [2] DOFLG: BYTE [1] ...=0 when /DO, =1 when /LOAD PAKSW: BY.gets addr. of USERCC when defined, else 1 LINKAD: WORD 1 ...if bit 0 even, =addr of binary file linker SYSTEM~ SC 0; RL0==080; RET ...test cond. code SYSTM~ SC 0; RET SEEK~ SC 5; RET FILLU0~ RL0:=INLVL FILLU~ ...get LU corres. to level RL0 ->RH0; savpe in:" /IF begin LDCTL R3,NSPSEG; R3==08100 end THEN *WRITE"/IMAGE Y2 ",^Y," 0",TABLE+@TABLE-1," E=",^Y+2," T=N" /ELSE *WRITE"/IMAGE Y1 ",^Y," 0",TABLE+@TABLE-1," E=",^Y+2," T=N" /ENDIF 0",TABLE+@TABLE-1," E=",^Y+2," T=N" /ELSE *WRITE"/IMAGE Y1 ",^Y," 0߭ߵE։+Y^Uf( _k)U#_[v=#-_e}܁܄;[܉;?ܐ~n P2ܔܗ:_ܛܞ;_ܦ/ܩ*s q شsܶDO LܽLOAD LēڻW_U~PACK ۪_rd$R ' EU.! @ CǩAQ Cݩ@P !S3[NIP!O3j 绕_2_@_D_H^YJ^Z^Z^ZTE [1] ...when=0, pack just globals; when=1, pack all not zapped CONSW: BYTE [1] ...=1 if const. expr. is in XINST, else 0 OUTLVL: BYTE [1] ...=LFIL if output file=list; =LFIL+1 if=image LUS~ BYTE [NLVLS+2] ...store LU# corres. to each level input or oe other regs. PUSH R1; RL1:=RL0; RH1:=0; LDB RH0,LUS-1[R1]; POP R1; RET STLU~ ...store LU# in RH0 in level RL0 RL0:->RL1; RH1:=0; LDB LUS-1[R1],RH0; RET CLOSFL~ ...close file of level RL0 (input=1-5, list=6, image=7) ...return RL0=cc FILLU(); R1:=0 S",TABLE+@TABLE-1," E=",^Y+2," T=N" /ENDIF EG_# PTRADDSUB.(\CONVERT_U)DPUTMLTK..CNVTACC_B*PUTADDc*PUTSUBm# SUBPTRS)PUTDIVK#PUTPUSH$PUTPP$PUTPOPS$.PUTLDREG0$vPUTLFIL~ EQU NLVLS+1 ...list file LU level CONLU~ EQU 2 RDHDL~ EQU 012 ...SC # to read current break handler WRHDL~ EQU 013 ...ditto write ...DEFRL~ EQU 0200 ...RL to use for IMAGE file (RIO) EOFCH~ EQU 01A ...CPM eof EOF~ EQU 0FF ...RIO eof MAGIC1~ EQU^Z^[^\^\^e:^eD^d^e$^Ql_ZCTest_n&<k+>/[_Y1CLatch._n_r?])C(G)1_rN/MJ06_epJ_r_qE]CErr0Y_qk.OUT(ߪYs.SAV(_q( nȗ_[u~CSavBz ߊutput file ...FILNML~ BYTE [1] ...FILNM~ BYTE [2+32] FILNM~ BYTE [MAXFNML+1] ORG $+1&0FFFE FILPOS~ WORD [2] POSTBL~ WORD [(NLVLS-1)*3] ...store inptr & file pos of lower level inpt files XSP: WORD [1] ...SP when start execution (also uses next word) GO_YSTM(RL0:=CLS) RET Quit1: PROC ...close any open input files (INLVL>0) NOTASCFLG:=0 RL0:=INLVL==0; RET Z CLOSFL(RL0:) INLVL:-1 JR Quit1 EOFSEQ~ BYTE EOFCH 0D EOF LEOFSEQ~ EQU $-EOFSEQ BYTE 0 Quit: PROC ...close files Quit1() ...close any opens!oPfP4aPaP 5 00 5 !oP!oPa`LLP4_QWRITE`LdP4n߷!7`ʽ,(`P5!c!!!Bء7 ^VcD>!u߽ 0E007 ...magic no. for proc. files FNF_ERR~ EQU 0C7 ...error code for file not found ...system cmds: OPN~ EQU 0 CLS~ EQU 1 RD~ EQU 2 WRT~ EQU 3 ...note: enter segmented Y: PROC; CALR START Y0: CALR START0 ...entry point when first loaded (looks in sys.xЈCSavЄБ){fЗ{PЛ}ЅУ$ТLДНАГШJ06ЛФЛФж?ПТЭ_YоCой| COutN×H_[_[11p)p"ўCOut),7_ZCIcopy_PS: WORD [1] ...4 word prog. status block used when starting execution: GO_PSFC: WORD [1] GO_PSPC: WORD [2] RSAV: WORD [3] ...save regs during ret. from or starting immx. SVQSP: WORD [1] ...save Q SP when do immx. PVARTAB: ;WORD [MAXNPVAR] ...saves s   input files Quit2: PROC; RL0:=DIAGSW if BITB RL0,2 not zero then begin ...now close output file if open PUSH R7 ... W.FPUTNX; LDB @R3,#0FF ...put 'FF' for EOF at next pos. in outpt buf. PUTFILE(R3:=^EOFSEQ; R7:=R3+LEOFSEQ) PUTOUT() ...put ouL1:=0 repeat RH1:=RL1 if RL0:=@R7=9 then begin repeat RL1:+1 until RL0:=RL1&7 zero; RL1:-1 end R7:+1; RL1:+1 until R3=R7; ...get RH1=col. of prev. char. repeat Echo(RL0:=8); Echo(RL0:=' '); Echo(RL0:=8) until RL1=RH1; R3:-1 POP..if in high buffer, pt. R7 to same rel. pos. in low ADDL RR2,#IN_RL end R7:->@R6; LDL R6[2],RR2 ...store old R7 (after CR) & file pos of buf end FILOPN()->R3 ...open file (rets. R3=0 iff ascii) SUBL RR4,RR4; LDL FILPOS,RR4 ...init. file puring ORG, DEFS, etc.) NCODE->LSTNCD if NOTASCFLG<>0 then Quit1() ...if error while doing non-ascii file if INLVL<>0 then begin ...check if from $CON or file R7:=LASTCR; R1:=0200; RL0:=0D CPIRB RL0,@R7,R1,EQ ...scan to next CR end ST1: RH1:=1 DL RR2,#0FFFF,FPUTBF LDL RR4,#0FFFF,FILNM SYSTEM(R0:=1*256+OPN) ...open output file if not zero then begin RESLLU(); JR OPNERR ...restore LU=list file in output vectors end STLU(RL0:=OUTLVL) ...store LU# RET FILOPN~ ...open input file (store Lt last record CLFPT() ...close file POP R7 if RL0<>080 then begin DIAGSW:=0; WRTERR() end end ...ZDGSW~ DIAGSW:=0 ...reset DIAGSW R0==R0; RET STARS~ R7:=^BUFF ...start of buffer CALL Copy DEFT '***** ' ...into buffer BYTE 0; RET MOVTXT:  R7; RL0:=8 end else begin RL0:->@R3; R3+1; PUSH R0; Echo(RL0:); POP R0 end until RL0=0D; RET Outmsg: PROC ...put to file if open + console (save regs>=R4 except R7 inc'd) RL0:=0D->@R7' ...put CR in buffer Outbuf: PUTFIL() ...put to file if oneos. to 0 NOTASCFLG:=1 ...for case of not ascii type (otherwise reset below) ... if BITB RL0,7 not zero then begin ...if proc. (instead of ascii) type ... R7:=^SEGDES ...start of segment descriptors ... R6:=^SEGSEGS ...NXTSEG~ LDL RR2,@R7; R3==0;  ...flag for no QINIT R15:=^MYSP ST2~ if DBGFLG<>0 then R15:=SAVSP ...chk if were in debugger if RH1=0 then QINIT() ...do init. set-up stuff (R8=myseg) GetrecD() ...get line of input or jp debugger ST3~ JP XMETA ...call parser /SEG START~ ...come heU); ret. R3=0 if ascii else 1st word PUSHL RR6 GETFNM() ... R1:=0 ...116 ...R1=#attr. ... LDL RR2,#0FFFF,BUFF LDL RR4,#0FFFF,FILNM SYSTEM(R0:=0+OPN); JR NZ,RESLU ...open input file RL6:=RH0; RH6:=0 STLU(RL0:=INLVL) ...store LU# R7:=read(R6,^BUFF,RL0:=9->@R7' ...put in tab R3:=LASTCR ...pos. after last CR in text R1:=LINEL-8-2 ...limit to search (-2 is for '?' or ' [') RL0:=0D; CPIRB RL0,@R3,R1,EQ R1:=R3-1 ...pos. of CR or end of line R1:-(R3:=LASTCR) ...length of line (without CR) RET Z open Putcon: PROC ... print from ^BUFF to R7 R3:=^BUFF; RL1:=0 while R3flag ...04000->flag ...set nonseg'd /NONSEG LDL SYSSP,RR4 ...save system SP RH1:=0; JR ST2 /SEG START0LINEL,->RL0)==1; JP LT,RDERR ...read am't big enough for proc file header+segtab SEEK(R3:=R6; SUBL RR4,RR4; R1:=0) if TSTASC(^BUFF,R7) then R3:=0 else begin R7==HDRSZ; JR ULT,WRGTYP; R3:=1 end POPL RR6 RET ... WRGTYP~ CLOSFL(RL0:=INLVL) ...close f; LDIRB @R7,@R3,R1 ...move text to buffer; ret with Z=1 if no text RESFLG Z; RET RESNST~ FREE:=^STACK ...res. STACK CALL RESNCD ...res. NCODE if tmp NCODE; R3=NCODE ... if NCDFLG<>0 then begin SAVNCD->NCODE; NCDFLG:=0 end ... R3:=NCODE R3:+1; RES R3,?' or RL0=0D; RET end P_ESC~ RL0==01B; RET NZ ...test for escape Quit1(); RESNST() ...poss. need to close files / res. NCODE/STACK JP Debug0 PUTREC: ...puts from ^BUFF to R7 to file if open, else to $CON PUTFIL(); JR NZ,Putcon; RET PUTFIL~ ...if ouTSEG ... end ... if BITB RL0,4 not zero then begin ...if binary if R3<>0 then begin ...if not ascii if DOFLG=0 then begin R1:=LINKAD if BIT R1,0 zero then begin FILLU0(); RL3:=RH0 ...pass LU in RL3 CALL @R1 ...LINKER should ~ ...come her via call from Q0 -- look at system cmd buffer (@RR12) while RL0:=@RR12=' ' or RL0=' ' do R13:+1 RL0:=@RR12==0D; JR Z,START; RL0==';'; JR Z,START LDL RR10,RR12; R1:=0 repeat R11:+1; R1:+1==120; JR Z,ST4 until RL0:=@RR10=0D or RL0=';'; ST4~ile if not ascii or proc. RL0:=0D2 ...error code for invalid type RESLU~ INLVL:-1 ...restore old log. unit no. OPNERR~ CALL ERRMCC; DEFT 'OPEN'; BYTE 0 GETFNM~ ...get filename from @LASTDE->^FILNM + add 0 ...call OPNERR if invalid PUSH R7 if GETFNM2(0; R3->NCODE; RET ...make sure NCODE even ERRMCC~ LASTDE->R3 ...^ Error R3<->stk ...LASTDE (ptr. to error)->stack; length of text->HL PUSH R0 ...R.A contains CC ERMGET() ...get msg. & put into buffer CALL Copy; DEFT ' ERROR ' ...goes into buffer POPtput file open, put to file, Z=1; else Z=0 BITB DIAGSW,2; COMFLG Z; RET NZ R3:=^BUFF PUTFILE~ ...below puts from R3 to R7 ->file PUSH R7 R3<->R7 PUTLUP~ R3-R7->R1 ...R1 gets length of text to be transfered R3:=FPUTRM ...space left in buffer if R3:-Rret. Z=0 iff bad header ... DATA1,2 free to use JR Z,FILDN2 end end else begin LOADFL(); JR Z,FILDN2 end JP WRGTYP end DOFLG==0; JP NZ,WRGTYP NOTASCFLG:=0 READFL() ...fill both low & high buffers R7:=^DATA1 ...pt. R7 to sta POPL RR8 ...R8=my seg R9:=^DATA1+4 LDIRB @RR8,@RR12,R1 ...move sys. cmd buffer to my input buffer LDB @RR8,#0D LDL RR4,RR14; R9:=^MYSP; LDL RR14,RR8 ...set SP R3:=flag; RES R3,15; R3->flag ...04000->flag /NONSEG LDL SYSSP,RR4 R7:=^DATA1; CALL CoR7:=LASTDE) not then OPNERR(RL0:=046) ...R3=beg., R5=len R7:=^FILNM; LDIRB @R7,@R3,R5 B.0->@R7 POP R7; RET GETFNM2~ ...test if valid filename @R7, incing R7 ...if true, ret. Z=1, R3=beg, R5=len VALIDCHR(B.@R7); RET NZ PUSH R7 repeat R7:+1 until VA R0; RL4:=RL0 ...CC in R.A Outhex() ...puts out value of unsuccessful completion code if RL4=FNF_ERR then begin CALL Copy; DEFT ' -NOT FOUND' end JR ERR1 Errm: PROC ... PRINT MESSAGE AFTER CALL R3:=LASTDE R3<->stk ...LASTDE (ptr. to error)->stack; le  1FPUTRM; R3:=FPUTNX ...next open buffer space R3<->R7; LDIRB @R7,@R3,R1 ...text->buffer RH0:->flag if zero then PUrt of buffer JP ST1 ...reset SP, get line of input & start parsing ... FILDUN: if RL0:=NUMERR<>0 then begin R7:=^BUFF; Copy(); DEFT "ERROR TOTAL="; BYTE 0 Outhex(RL0:); Outmsg() end FILDN2~ if RL0:=@(R5:=^INLVL)<>0 then begin CLOSFL(RL0:) ...cpy; DEFT '/DO '; BYTE 0 ...now /DO FILENAME in input buffer QINIT() ...R8=my seg. GETRCX(R7:=^DATA1) ...start of input buff.->DE->LASTCR->LASTDE JR ST3 ...call parser QINIT~ R8:->QSEG if BIT NCDSEG,15 zero then R8:->NCDSEG->RUNSEG INLVL:=0 ...LIDCHR(B.@R7) not; POP R3 if R5:=R7-R3<=MAXFNML then R0==R0 RET INVCHS~ DEFM ';,<>=*' LINVCHS~ EQU $-INVCHS VALIDCHR~ PROC ...test if RL3=valid char. for filename ...(system may limit further) RL3==021; RET ULT; RL3==07E; RET UGT R5:=^INVCHS; R1:=Lngth of text->HL ERMGET() ...get msg. & put into buffer JR ERR1 ERMGET~ PUSH R3 ...save ptr. to text of error msg. STARS() ...to put out '***** ' POP R3 RL1:=@R3; RH1:=0 ...put length of message into BC R3:+1 LDIRB @R7,@R3,R1 ...move text into buffeTOUT() ...if buffer is exactly filled else begin R3<->R7 if carry then begin ...if buffer overflows PUTOUT() R3:=@R15; JR PUTLUP end R3->FPUTNX end POP R7; R0==R0; RET FINBUF: ...if list file open, fill rem. buffer with spaces +lose input file DECB @R5 ...decrement level end NOTASCFLG:=0 ...only top level can be non-ascii if RL1:=@R5<>0 then begin ...check if back to $CON or still a file RH1:=0 MULT RR0,#6 ...R1:*6 R6:=^POSTBL-6+R1 ...R6=^where to store currenfile would be marked open if Q imaged from file BtoQ0() ...set brks->Q if not set elsewhere ... SCtoQ() ...handle SC's with bit 7=1 RET Echo~ ...echo char. & keep track of col. in RL1 if RL0=9 then begin repeat Put1(RL0:=' '); RL1:+1 until RL0:=RLINVCHS; CPIRB RL3,@R5,R1,EQ; COMFLG Z RET ...VALIDCHR0~ ...test if RL3=valid starting char. for filename ... if RL3>='0' and RL3<='9' or RL3:&0DF>='A' and RL3<='Z' then R0==R0 ... else RESFLG Z ... RET ...VALIDCHR~ ...test if RL3=valid char. for filenamr RET Err0: RET Z ...flag must be not zero (enter here from rst) Err: PROC PUSH R7 ...ptr. to error STARS() ...put '***** ' into buffer ERR1~ Outmsg() ...add CR & send out R7:=^BUFF NUMERR:+1 ...increment error count HLout(W.LSTNCD) ...put outCR at end & put out BITB DIAGSW,2; RET Z ... R1:=FPUTRM; R3:=FPUTNX ... repeat LDB @R3,#' '; R3:+1 until R1:-1 zero; ... R3:-1; LDB @R3,#0D ...fall thru: ... PUTOUT~ ...R1:=OUT_RL; R1:->FPUTRM; R3:=^FPUTBF->FPUTNX; R2:=QSEG R1:=OUT_RL-FPUTRM; FPUTRM:=Ot pos. R7:=@R6 ...old inptr LDL RR4,R6[2] ...old file pos. LDL FILPOS,RR4 READFL() ...read into low buffer, starting at saved file pos., ... then fill high buffer, not waiting end ... GetrecD~ ...test if to jp to debugger or do Getrec1&7 zero; RET end if RL0=0D then RL1:=0 ...begin RL1:=0; Put1(RL0:); RL0:=0A end else begin RL1:-1 if RL0<>8 then begin RL1:+2; if RL0<' ' or RL0=07F then RL0:='#' end end ... Put1: PROC ...put out 1 char. (in RL0) to console PUSHL RR0; RL0:=e ... PUSH R3; VALIDCHR0(); POP R3; RET Z ... RL3=='.'; RET Z; RL3=='_'; RET Z ... RL3=='/'; RET Z; RL3==':'; RET TSTASC~ ...enter R3=^1st R5 bytes of file; chk if all ascii before EOFCH while R5<>0 do begin RL0:=@R3==EOFCH; RET Z RL0==EOF; RET Z  starting addr. of code for line if NOTASCFLG<>0 then begin R5:=^DATA1->LASTCR; B.0D->@R5 end MOVTXT() ...put out tab + move text to buffer, truncating if too long POP R1 ...ptr. to error in text PUSH R7 ...pts. after last char. in buffer if R3-R1>UT_RL; R3:=^FPUTBF->FPUTNX; R2:=QSEG PUTO2~ ...R1=len to write, RR2=addr PUSH R1; PUSHL RR2 FILLU(RL0:=OUTLVL) SYSTEM(RL0:=WRT) POPL RR2; POP R1 RET Z PUSH R0 if OUTLVL=LFIL then DIAGSW:=0 ...if list file, zero DIAGSW CLFPT() ...close output file if INLVL=0 and DBGFLG<>0 then begin R15:=SAVSP; JP DBUG2 end ... Getrec: PROC ...enter with DE pointing after CR (or START) ...assure another CR in buffer if INLVL<>0 then begin ...chk if getting from file or console R3:=^DATA2 CPB @R7,#EOFCH;WRT; R1:=1 PUTGET~ RH0:=CONLU PUSHL RR2; R2:=0FFFF; R3:=R15+5 SYSTEM() POPL RR2; POPL RR0; RET ... Get1: PROC ...get 1 char. from console ->RL0 PUSHL RR0; R1:=1 GET1A~ RL0:=RD; JR PUTGET Get1if: ...get 1 char. from console if ready (Z=1 if char.; Z=0 BITB RL0,7; RET NZ R3:+1; R5:-1 end RET NEWFIL: PROC ...enter with DE at CR; LASTDE contains ptr. to input file name ... followed by delimiter RL1:=INLVL==NLVLS; JP NC,TUDEEP ...files go to max level 5 INLVL:+1 ...inc. file level if RL1<>0 zero ...R3 at CR in text, R1 at error and begin PUSH R3; R3:=^DATA1-1-R1; POP R1 end R1 R3:=R7-1 ...R3 pts. at last char. in buffer LDDRB @R7,@R3,R1 ...sh without trying to empty buffer POP R0 WRTERR~ CALL ERRMCC; DEFT 'WRITE' CLFPT~ CLOSFL(RL0:=OUTLVL) ...close file; rets. RL0=cc ... RESLLU~ OUTLVL:=LFIL; RET ...restore list file LU#; save RL0 LFILOPN: ...open list file; LASTDE pts. to filename follo JP Z,FILDUN ...check if at EOF CPB @R7,#EOF; JP Z,FILDUN R5:=R7 if R3:=R3-R7<=zero then begin ...chk if R7 in hi or low buffer ...in high buffer: R7:-IN_RL->R3; RES R3,0 R1:=(R1:=^DATA2-R3)/2 LDIR @R3,@R5,R1 ...move r if no char.) PUSHL RR0; R1:=0; JR GET1A GetN~ PROC ... gets to CR, echoing, backspacing, storing @R7 (saves R7) R7:->R3; RL1:=0 ...RL1=col. repeat Get1() ...get byte if RL0=8 then begin ...if backspace RL1:+1; RL1:-1; JR Z,GetN PUSH R7; Rthen begin ...if old level not console RH1:=0 MULT RR0,#6 ...R1:*6 R6:=^POSTBL-6+R1 ...R6=^where to store current pos. R7:+1 ...move R7 past CR LDL RR2,FILPOS if R7>=^DATA2 then begin ...chk if in low or high buffer R7:-IN_RL .ift text that is past error ahead 1 space in buffer end RL0:='?'->@R7 ...insert '?' before char. in error POP R7; R7:+1 ...pts. after last char. in buffer Outmsg() ...add CR & put out to $CON & file if open RESNST() ...res. STACK & NCODE (if error dwed by a delimiter OFILOPN(RL0:=LFIL) ...; R1:=0) ...open output file with LU level=6 SETB DIAGSW,2 ...mark for file output RET OFILOPN~ RL0:->OUTLVL; ...PUSH R1 ...RL0=output file level, ...R1=#attr. GETFNM() ...filename->@FILNM+ ... POP R1 ... L emaining portion of high buffer to same rel. pos. in low LDL RR0,#IN_RL LDL RR4,FILPOS; ADDL RR4,RR0; LDL FILPOS,RR4 ...update file pos LDL RR2,#0FFFF,DATA2 ...R1=IN_RL READF() ...RDFIL2() ...fill high buffer end end else begin GL RR2; Quit(); BRKStoP(); ...SCtoP() POPL RR2; R12:=QSEG; R13:=R7 LDL RR4,SYSSP; R0:=0C040->flag /SEG LDL RR14,RR4; JP @RR2 /NONSEG RETSYS: ...ret. to system, closing files & setting seg'd Quit(); BRKStoP(); ...SCtoP() LDL RR4,SYSSP; 0C040->flag /SEG='"'; RET NZ end R7:+1; RL0:->RL1; JR SR2 SRBEG: CPB @R7,#'"'; RET NZ; R7:+1 Sr: PROC ...advance DE until @DE=quote, starting at DE+1 RL1:='"' SR2~ SRDO(RH1:=80) ...max count=80 RET Z TULONG~ Errm(); DEFT 'TOO LONG'; BYTE 0 SRDO~ ...enter with RL1=e from ... while GET2W() not zero do begin ...go thru segment descriptors ... ...GET2W rets. R7=seg beg adr, R1=seg len ... PUSH R3 ... R3:=R7; R2:=@R6' ... PUTO2() ...put out whole seg. ... POP R3 ...HL pts to next seg. des. in buffer ... end NHASH: EQU 32 Test: PROC ...enter with DE->data; ret. addr.->DEFT 'STR' to compare against ...returns Z=1 if found, DE->next char., LASTDE=old DE ...saves other regs>R3 POP R3 R1:=@R3 if RL1<>@R7 then begin ...test 1st char. RH1:->RL1-RH1; R3:+RETCNS~ ...reads in a line from $CON, rets. R7->1st char. RL0:=CPRMPT Getcon: PROC ...come here with R.A=prompt char. Put1(RL0:) NUMERR:=0 ...zero error count GetN(R7:=^DATA1) ...get new chars; DE pts. to beg. of buffer end GETRCX~ R7:-> LDL RR14,RR4; RET /NONSEG BtoQ0~ ...set brks->Q if not set elsewhere RDBRKA() ...curr. value in system BRKRTN->RR2 BIT R3,0; RET Z; JR BtoQ2 ... BRKStoQ: BITB SCBFLG,0; COMFLG Z; RET Z ...brks already set->Q RDBRKA() ...curr. value in system BRKRTnd str. char; RH1=max. count R7:->LASTDE; RL0:=@R7 repeat RL0==0D; JR Z,TULONG; R7:+1; RL0:=@R7==RL1; RET Z until RH1:-1 zero; ...note: above must be DJNZ RET ...Sr1: PROC ...testing for exactly one byte not " ... SRDO(RL1:='"'; RH1:=1); RET Z ... ... CLFPT() ...close file; restore list file LU->vectors ... if RL0<>080 then WRTERR() ... POPL RR6; R3==R3; RET IMGSUB: PROC ...do IMAGE, filename @LASTDE, E_ADD(bytes<->),E_SEG=entry pt. ...if E_SEG=0FFFF, do simple image, else put header 1st ...if 1; RES R3,0; JP 2(R3) ...test failed end R2:=R7; R7:+1 if RH1:-1 zero then begin R2:->LASTDE; JP 2(R3) end ...if only 1 char. R3+2; RH1:->RL1-RH1 CPSIRB @R7,@R3,R1,NZ ...test rem. chars. if not zero then begin R2:->LASTDE; R3:+1; RES R3,0; R3==LASTCR; R7:->LASTDE ...LASTDE needed in case Errm before set RL0==RL0; RET READFL~ ...enter with RR4=file pos to read at ...fill both low & high buffers FILLU0() ...LU->RH0 SEEK(RL3:=RH0; R1:=0) R1:=IN_RL*2 LDL RR2,#0FFFF,DATA1 READF: ...come here N->RR2 BtoQ2~ LDL BRTNSV,RR2 ...save it SETB SCBFLG,0 R2:=QSEG; R3:=^B_RTN; JR SETBR ...set brks->Q BRKStoP: BITB SCBFLG,0; RET Z RESB SCBFLG,0 LDL RR2,BRTNSV ...restore BRKRTN to prev. state SETBR~ WRBRKA(); R0==R0; RET WRBRKA~ R5:=0; SC WRHDL; RER7:-1; RESFLG Z; RET Cnt: PROC ...inserts count byte into output R3:=NEXTDE-LASTDE RL3:->@R7' RET SPCMA~ ...check if @HL=' ' or ',' RL0:=@R3==' '; RET Z; RL0==','; RET Inhex: PROC ...convert 2 hex digits @R3 to value in RL0, inc. R3 PUSH R1 ASCtoBIT E_SEG,15 zero then mark image relocatable by segment OPNIMGFIL() if E_SEG<>0FFFF then PUTHDR() PUTIMG() CLSIMGFIL() RET PUTHDR: ...write out header & segtab to image file ...info @SegDes,SegSegs + E_ADD,E_SEG save R6..R11 MGKNO:=MAGIC1 R2:=E_R3; JP @R3 ...succeed end R7:=R2; R3:+R1+1; RES R3,0; JP @R3 ...fail XLAT~ DEFM ' :;<=>?' ... 0 - 9 DEFM '@ ' ... A - O DEFM ' [\]^ ' ... P - Z and _ DEFM '` ' ... a - o DEFM ' {|}~'; BYTE 0with RR2,R1 set FILLU0() ...LU->RH0 SYSTEM(RL0:=RD) RET Z; RL0==0C9; RET Z ...EOF error ok ... RDERR~ PUSH R0; Quit1() ...close files (return to console after CALL Err) POP R0; CALL ERRMCC; DEFT 'READ'; BYTE 0 LOADFL~ ...load image with magic no. T RDBRKA~ R5:=0; SC RDHDL; RET O_VERSN: ...Y version msg->@R7' R3:=^YVERS; R1:=LVERSN; LDIRB @R7,@R3,R1; RET RDaHL: PUSH R2; R2:=NCDSEG; RDaRR2(); POP R2; RET WRaHL: PUSH R2; R2:=NCDSEG; WRaRR2(); POP R2; RET WRaDEi: PUSH R3; R3:=R7; WRaHL(); RL3:=flaN(RL0:=@R3); RL0:*16->RL1 ...high nibble ASCtoN(RL0:=@(R3:+1)); RL0:|RL1 R3:+1; POP R1; RET ASCtoN: PROC ...converts ascii char. 0-9,A-F in R.A to its value if RL0>='A' then RL0:-7; RL0:&0F; RET InhexW: PROC ...convert 2 hex digits @R3 to value in SEG; R3:=E_ADD; EXB RL3,RH3; LDL E_PT,RR2 R0:=2**NORELOB ...no reloc. info if BIT R2,15 zero then SET R0,RELOSEGB ...reloc. by seg. R0:->HDRFLGS SYMTBSZ:=0; RELOCSZ:=0; HDRUNUSD:=0 ...fill in segtab,imgsz,bsssz,segtbsz: R3:=^SegDes; R10:=^SegSegs; 7F ... p - z Id: PROC ...test for upper or lower case seq of letters & digits, starting ... with upper case letter; i-o same as Test RL0:=@R7=='A'; RET C RL0=='Z'; RET UGT R7:->LASTDE R1:=^XLAT-'0'; RH0:=0 repeat R7:+1; RL0:=@R7=='0'; JR C,RetZ MAGIC1, header+segtab are in BUFF ...ret Z=1 if succeed, Z=0 if bad header, else call RDERR on err R1:=^BUFF CP @R1,#MAGIC1; RET NZ save R6..R11 R6:=R1 FILLU0(); RL7:=RH0 ...get RL7=LU R5:=HDRSZ+@R6[H_SEGT] R8:=R6+R5 ...end of segtab SEEK(RL3:=Rg; R7:+1; RL3:->flag; POP R3; RET RDBCaHL: PUSH R2; R2:=NCDSEG; RDR1aRR2(); POP R2; RET WRBCaHL: PUSH R2; R2:=NCDSEG; WRR1aRR2(); POP R2; RET WRDEaHL: PUSH R1; R1:=R7; WRBCaHL(); POP R1; RET RDaRR2: ...RL0:=@RR2 PUSH R5; R5:=flag; SET R5,15; R5:->flag /SR3 PUSH R1; Inhex(); RL0:->RH1; Inhex(); RL0:->RL3; RH3:=RH1; POP R1; RET OuthexL: PROC ...RR2 in hex->@R7' PUSH R3; HLout(R3:=R2); POP R3 ...cont: ... HLout: PROC ...put out R3 in hex at R7, incrementing R7 PUSH R0; Outhex(RL0:=RH3); Outhex(RL0:=RR11:=^SEGTAB SUBL RR8,RR8; LDL BSSSZ,RR8 while GET2W() not zero do begin ...R7=addr, R1=len PUSH R3 R6:=@R10'; LDL R11[SG_ADDR],RR6 R1:->@R11[SG_LEN]; R0:=0->@R11[SG_TYP] ADDL RR8,RR0 R11:+SGENTSZ POP R3 end LDL IMGSZ,RR8 R11:-^SE until RL0=@(R3:=R0+R1); RET ...Z=1 Digit: PROC ...test for a digit RL0:=@R7 RL0=='0'; RET C RL0=='9'; RET UGT STARIT~ R7:->LASTDE; R7:+1 RetZ~ RL0==RL0; RET ...set Z=1, RL0=char. tested Hexd: PROC ...test for a hex digit; ret. in RL0 Digit(); RL7; R5:;R4:=0; R1:=0) ...seek to start of image LDL RR10,R6[H_ENTRY] R9:=R6+HDRSZ ...beg of segtab R6:=@R6[H_FLG] while R9@RR2 PUSH R5; R5:=flag; SET R5,15; R5:->flag /SEG RL0:->@RR2; JR RWaRX ... /NONSEG RDR1aRR2: ...R1:=@RR2 PUSH R5; R5:=flag; SET R5,15; R5:->flag /SEG R1:=@RR2; JR RWaRX ... /NONSEG WRR1aRR2: ...R1:->@L3); POP R0; RET OUTHRL: ...puts into out area 'H' + RL3 in hex Outset(); LDB @R7,#'H'; R7:+1; RL0:=RL3 ...cont: ... Outhex: PROC ...RL0 converted to hex & stored at R7 & R7+1; R7=R7+2 PUSH R0; RL0:/16; HBTHEX(); POP R0 HBTHEX~ if RL0:&0F+'0'>'9' theGTAB->SEGTBSZ PUTO2(R3:=^MGKNO; R2:=QSEG; R1:=HDRSZ+R11) restore R6..R11 RET OPNIMGFIL: ...open image file & write out attributes PUSH R7 ... FTYP:=088; FPROPS:=0 ...set attr.; subtype bit 3=1 =>Z8000 ... R3:=DEFRL; LDB F_RL,RL3; LDB F_RL+1,RH3 ...RET Z RL0=='A'; RET C RL0=='F'; JR ULE,STARIT RL0=='a'; RET C RL0=='f'; JR ULE,STARIT RET ...false Num: PROC ...RL0 has digit; get value of digit sequence->RR2 PUSH LASTDE; SUBL RR2,RR2 repeat ADDL RR2,RR2; LDL RR4,RR2; SLLL RR2,2; ADDL RR2,RR4 10 R1:=@R9[SG_LEN] ... SET R2,15; RL2:=0 ...for CKNOTINY ... CKNOTINY(); RL0:=043; JR NZ,RDERR RH0:=RL7 SYSTEM(RL0:=RD); JR NZ,RDERR end R9:+SGENTSZ end restore R6..R11 R0==R0; RET ...CKNOTINY: ...ret Z=1 iff section of adRR2 PUSH R5; R5:=flag; SET R5,15; R5:->flag /SEG R1:->@RR2; JR RWaRX ... /NONSEG LDIRB_: ...LDIRB @RR6,@RR2,R1 PUSH R5; R5:=flag; SET R5,15; R5:->flag /SEG LDIRB @RR6,@RR2,R1 RWaRX~ RES R5,15; R5:->flag /NONSEG POP R5; RET ... ...LDIR_: ...LDIR @RR6,@n RL0:+7; RL0:->@R7'; RET OutADR: ...print addr in RR2 (incl. seg.) RL0:=RH2&0F+'0'; if RL0>'9' then RL0:+7 RL0:->@R7' RL0:='.'->@R7' ...fall thru: HLout(); RET OutSP: LDB @R7,#' '; R7:+1; RET ...TABLE ENTRY FORMAT OF SYMBOLS (byte pos. from beg. oL=200 ... LO_ADD:=0 ...set LO_ADD to 0 so won't load on Z80 ... R3:=^SegDes; R4:=0 ...get HI_ADD: ... while GET2W() not zero do begin ...go thru segment descriptors ... ...GET2W rets. R7=seg beg adr, R1=seg len ... if R7:+R1-1>R4 then R7:->R4 ... en ...RR2:*2->RR4; RR2:*4+RR4 RL1:=RL0&0F; RH1:=0; R0:=0; ADDL RR2,RR0 until Digit() not zero; POP LASTDE; R0==R0; RET HNum: PROC ...checks for hex no.: value->RR2; else RR2=0 PUSH LASTDE; SUBL RR2,RR2 while Hexd() do begin ASCtoN(RL0:); RL0:->Rdr RR2, len R1 not over Y ... ...(R2 std form); preserve RR2,R1 ... if R2=QSEG then begin ... if R3>=^Y then begin R3==^ENDRAM; RET ULT end ... else begin R0:=R3+R1==^Y; RET UGT end ... end ... R0==R0; RET GET2W~ ...next 2 words @R3 go to R7 & R1, R3 RR2,R1 ... PUSH R5; R5:=flag; SET R5,15; R5:->flag .../SEG ... LDIR @RR6,@RR2,R1; JR RWaRX .../NONSEG *ZAPALL TMPS *PACK ALL .. PUSH R5; R5:=flag; SET R5,15; R5:->flag .../SEG ... LDIR @RR6,@RR2,R1; JR RWaRX .../NONSEG *ZAPALL TMPS *PACK ALL F_ST SEGf entry): HIVAL: EQU 0 ...value of symbol LOVAL: EQU 2 LINK: EQU 4 ...link : 2 bytes TYPE: EQU 6 LNGTH: EQU 8 ...length of symbol name NAME: EQU 9 ...start pos. of name ...low nibble of TYPE word (symbol type): LABLT: EQU 0 ...normal label BYTET: EQU 1 ...d ... RL4:<->RH4; R4:->HI_ADD OFILOPN(RL0:=LFIL+1) ...; R1:=116) ...open output file (7=LU level) POP R7; RET PUTIMG: ...put out code image PUSHL RR6 R3:=^SegDes; R6:=^SegSegs2 ...beg. of descpts. of where to image from while GET2W() not zero do beL1; RH1:=0; R0:=0 SLLL RR2,4; ADDL RR2,RR0 ...RR2:*16+RR0 end POP LASTDE; R0==R0; RET ... [ABC] => CALL Latch;WORD ABC ... Latch is a call allowing undefined symbols Latch: PROC R3:=@(@R15) ...R3=^ABC Latch2: R3==1; JP NZ,@R3 ...if R3<>1, jump to inc'ed; R1 tested for 0 R7:=@R3'; RL7:<->RH7 R1:=@R3'; RL1:<->RH1 R1==0; RET ...IMGSUB: ...do IMAGE (LASTDE=^filename) ... ...enter with segment descriptors & entry pt. as go on descriptor ... ... record in FPUTBF ... PUSHL RR6 ... FTYP:=088; FPROPS:=0SEGS ...*ZAP FPUTRM FPUTNX NUMERR FILTYP ...*ZAP FTYPE SEGDES DATA1 DATA2 ...RDFLG RDERRFLG ...*ZAP CLOSFL SYSTEM ZDGSW STARS RESNST ERRMCC ERMGET ERR1 ST2 ST3 ...*ZAP START START0 ST4 QINIT Echo GetN P_ESC ...*ZAP PUTFIL PUTLUP PUTOUT PUTO2 WRTERR CLFPT if defined as BYTE WORDT: EQU 2 ...if defined as WORD PROCT: EQU 3 ...if PROCedure definition ADDRT: EQU 13 ...4 ...if defined by ADDR EQUT: EQU 11 ...5 ...if defined by EQU REGT: EQU 7 ...6 ...register type BASBYTT: EQU 5 ...7 ...based byte BASWRDT: EQU 6gin ...go thru segment descriptors ...GET2W rets. R7=seg beg adr, R1=seg len PUSH R3 ... LDL RR2,@R6; R6:+4 R3:=R7; R2:=@R6' PUTO2() ...put out whole seg. POP R3 ...R3 pts to next seg. des. in buffer end POPL RR6; RET CLSIMGFIL: ...croutine RESFLG Z; RET ...COPY routines: output to @R7 with R7 updated Icopy: PROC Outset() Copy: PROC ...DEFT to copy follows call R3<->stk; PUSH R1 RL1:=@R3; RH1:=0 ...get count R3:+1; LDIRB @R7,@R3,R1 POP R1; R3:+1; RES R3,0; R3<->stk RET Copyin ...set attr.; subtype bit 3=1 =>Z8000 ... R3:=DEFRL; LDB F_RL,RL3; LDB F_RL+1,RH3 ...RL=200 ... LO_ADD:=0 ...set LO_ADD to 0 so won't load on Z80 ... R3:=^SegDes; R4:=0 ...get HI_ADD: ... while GET2W() not zero do begin ...go thru segment descriptorsLkupnlexPpOfASMSTgCOMMANDfLABELCOLqXCOMM INSTYR#TestZZ#DelZ~#IcopyZ#Copyin@Z#Copy[*#Outset\&#Out\ #OutNGeB#SaveL#SavBAd#Gene,#Z ...8 ...based word BARRAYT: EQU 9 ...byte array WARRAYT: EQU 10 ...word array LONGT: EQU 4 ...11 ...LONG ...bits of TYPE word: UNDEFB: EQU 4 ...=1 if undefined REFB: EQU 5 ...=1 if defined but not referenced ZAPB: EQU 13 ...6 ...=1 if symbol zapped (reusalose image file CLFPT() ...close file; restore list file LU->vectors if RL0<>080 then WRTERR() RET ...Z=1 ...********* /NONSEG JPNEW: ...start new program @RR2 (seg'd) with SP=SYSSP, RR12=Qseg,R7 ...also close files & restore BRKADR, SC_ADR PUSH: PROC ...copies from LASTDE to NEXTDE R1:=NEXTDE-(R3:=LASTDE) LDIRB @R7,@R3,R1 RET Del: PROC if RL0:=@R7<>' ' then begin RL0==' '; RET NZ end repeat RL0:=@(R7:+1) until RL0<>' ' and RL0<>' '; RL0==RL0; RET String: if RL0:=@R7<>''' then begin RL0= ... ...GET2W rets. R7=seg beg adr, R1=seg len ... if R7:+R1-1>R4 then R7:->R4 ... end ... RL4:<->RH4; R4:->HI_ADD ... OFILOPN(RL0:=LFIL+1; R1:=116) ...open output file (7=LU level) ... R3:=^SegDes; R6:=^SegSegs2 ...beg. of descpts. of where to imagepQb$#Err0el#ReEe|#Xc0e#WRe0Oe#WRe4e#WRe8a3 5aaӂ˩!71!11ߴMrߴߥMara;]/oMMM!! P! ]4!7oo ble) ...EXTB: EQU 12 ...set if external symbol (has corres small 1st letter sym.) ...chain types (bits 8-10), =0 if none: ABSCH: EQU 2 REL8CH: EQU 1 REL12CH: EQU 3 REL16CH: EQU 4 ABS32CH: EQU 5 SCSHFT: EQU 04000 ...scope in high 2 bits ...scope types: GLrry then begin ...if back ref. BKREF0() ...chk ch. type, NCODE->(LOC) R3:=R5+1 ...R3:=OFFSET+R5+1 ...because DISP subtracts offset & 1 end else begin ...if defined MRKREF() ...ind. has been referenced R5:->R3 ...old (LOC) enain pts. forward RH1:=-1 R3:+R1+R1 ...next chain location ->R3 JR AL1 AL3~ ...resolve 12-bit chain PUSH R7; PUSH R3 ...R7=value of label ($), R3=addr of ref. R3<->R7; DISP12(); R3<->R7 ...get diff. addr+1-$ ->R7, checking for out-of-range POP Rarry then begin ...if back ref. GETCHTYP(); RL0==REL12CH; JR Z,DOCALR JR DOCALL end if SEGMD<>0 and R1:=@R13[HIVAL]&07F00|08000<>RUNSEG then begin ...if def'd in another seg. WRaDEi(RL0:=05F); RL0:=0 JR DOCALL2 ...7; JP NZ,OORERR_ ...DJNZ type: if BITB RH1,4 not zero then SETB RL0,7 ...RH1='B','W'=>bit 7,A=reset,set JP OREL8 end if RL0='D' then begin ...DEFINE type PUSH R7 ...save NCODE Inhex(); RL0:->RH6; Inhex(); RL0:->RL6 Inhex(); RL0:->ROBSC: EQU 3 TMPSC: EQU 1 LOCALSC: EQU 2 Outset: PROC ...set up for OUT functions R7:->NEXTDE R7:=^BUFF RET ...LDI_N2: R1:=02FF ...move 2 chars if no., plus '-' ... repeat if RL0:=@R3&0F0=030 then LDIB @R7,@R3,R1 until RH1:-1 zero; ... RL0:='-'->@R7';d DISP() ...disp. to be inserted ->RL0 end else begin ...if not found NOTFND0() ...mark undef, set ch. type, NCODE->(LOC) RL0:=0 ...0 to mark end of 1-byte chain end OREL8~ WRaDEi() ...put out rel. disp. to addr. or prev. ref. RET ISA3~ 3 RDBCaHL(R3:-1) ...contents of current addr. in chain ->R1 RL0:=RH1&0F0; RH7:|RL0 WRDEaHL() ...store at addr. the calculated rel. displacement RL0:=RH1&0F|RL1; POP R7; RET Z ...check for 0 => end of chain BITB RH1,3; JR Z,OORERR ...error if chaR1=seg. end DISP12A(@R13[LOVAL])+1; TSTRG12A() ...if defined, test disp. JR Z,DOCALR ...if in range, do rel. ref. DOCALL~ WRaDEi(RL0:=05F); RL0:=0 ...out-of-range, do absolute CALL DOCALJP~ R1:=RUNSEG DOCALL2~ WRaDEi(RL0:) H7; Inhex(); RL0:->RL7 ...RR6=def. value ... R6:=0 ...for now JR CPDL1 end RL0=='L'; RET NZ ...do nothing if 1st char. anything else ...LABEL PUSH R7 ...save for NCODE ... PUSH R3; W.OFFSET+R7; R3<->R7; POP R3 ...add offset R6:=RUNSEG CPDL1~  RET ...VDATE: ...puts out Q version no. & date ... CALL Icopy; DEFT 'Y VERS ' ... R3:=^YVERS+2; R1:=4; LDIRB @R7,@R3,R1 ...version no. ... B.9->@R7; R7:+1 ... LDI_N2(R3:=DATE+2) ...month ... LDI_N2() ...day ... LDI_N2(^DATE); R7:-1 ...year, delete tra...12 bit rel. chain LKUPA() A3A~ RL1:=REL12CH if zero then begin ...if found R5:=@R13[LOVAL] ...(LOC)->BC if carry then begin ...if back ref. BKREF0() ...chk ch. type, NCODE->(LOC) R3:=R5-R7; TSTRNG12() ...divide by 2 & chk range in pts. forward RH1:|0F0 R3:+1+R1+R1 ...next chain location ->R3 JR AL3 AL_L~ ...resolve 32-bit chain; RR6=value, RR2=last ref RDR1aRR2(); R4:=R1; RDR1aRR2(R3:+2); R5:=R1 ...RR4:=@RR2 WRR1aRR2(R1:=R7); WRR1aRR2(R3:-2; R1:=R6) ...RR6->@RR2 TESTL Rif SEGMD<>0 then begin ...R1=seg. set above WRaDEi(RL0:=RH1); WRaDEi(RL0:=RL1) end POP R0; RH0:->flag; JR A2A end if RL0='J' then begin ...jump type (Z8000 only) Inhex(); RL0:->RH0; PUSH R0 ...get cond. code if begin LKUPA(); POP R1if S_LKUP() not carry then begin ...call Lkup, chk if no back ref. if zero then begin CKRDFERR() ...if already defined, chk if can redefine SETCHTYP(RL0:=0) ...make sure no chain set (shouldn't be) end SET TYPE[R13],REFB ...mark not iling '-'; continue below: ... Outp: PROC ...put out from ^BUFF to R7 (+CR) to file if open, else to $CON RL0:=0D->@R7'; PUTREC() JR OUTDUN ...NEXTDE->DE; 1->Z Outlin: PROC ...put out from ^BUFF to R7 (+CR) to console & file if open ...NEXTDE->R7,  end else begin ...if defined MRKREF() ...ind. has been referenced R5:->R3 ...old (LOC)->R3 DISP12() ...get R7+1-(R3-OFFSET)->R3 =disp. to insert end end else begin ...if not found NOTFND0() ...mark undef, set ch. type, NCODE->R4; RET Z ...0=>end of chain LDL RR2,RR4 ...next chain loc. JR AL_L DISP~ ...calcs. R3-OFFSET-(R7+1), checking for out-of-range, & stores in RL0 ...R7 unchanged DISP0() ...R3-OFFSET-(R7+1) TSTRNG~ HLDIV2() ...if doing Z8000 code, divide by 2 RL0:; RH0:=flag; PUSH R0 end not zero then begin ...if not found: DOJR~ WRaDEi(RL0:=RH1|0E0); POP R0; RH0:->flag; JP A1A ...do rel. ref. (RH1=cond. code) end if carry then begin ...if back ref. GETCHTYP(); RL0==REL8CH; JR Z,DOJR ref'd end RES TYPE[R13],UNDEFB ...set defined CPDL2() ...put value in symbol table, resolve chain POP R7; RET CPDL2~ ...store RR6 in symbol table, resolve chain LDL RR2,R13[HIVAL] ...RR2=addr of last ref if any LDL R13[HIVAL],RR6 ... R7:->@R13[LOsave other regs>=R4 Outmsg(); JR OUTDUN ... OutN: PROC Icopy(); DEFT 'H' POP R3; R1:=@R3 if RH1=0 then begin RH1:=RL1; R3:+1 end R3:+1 repeat Outhex(RL0:=@R3') until RH1:-1; PUSH R3 ... Out: PROC ...C->CALL L->LABEL '->STRING ...A1->AL1 A2->AL2(LOC) R3:=0 ...0 to mark end of 12-bit chain end OREL12~ R3->R1 RDaHL(R3:=R7-1); RL0:&0F0; RH1:|RL0 WRBCaHL(); R7:+1 ...put out rel. disp. to addr. or prev. ref. RET ISAL~ ...32-bit ref; RR6=NCODE LKUPA() RL1:=ABS32CH if zero then begin ...if=RL3 TSTRG8B(); RET Z OORERR~ OORERR_~ CALL Errm; DEFT 'OUT OF RANGE'; BYTE 0 HLDIV2~ R3:/2; RET NC ...R3/2, err if R3 odd CALL Errm; DEFT 'ODD DISP.' TSTRG8A~ ...do R3/2; ret NZ if out of 8-bit range HLDIV2() TSTRG8B~ if RH3:+1 zero and BITB RL3,7 n JR DOJP end PUSH R1 DISP0(@R13[LOVAL])-1; TSTRG8A() ...if defined, test disp. POP R1; JR Z,DOJR ...if in range, do rel. ref. DOJP~ WRaDEi(RL0:=05E); RL0:=RH1 ...out-of-range, do absolute JP JR DOCALJP ...first puts out R.A end RL0=VAL] ...value->table GETCHTYP(); RL0==0; RET Z ...no chain RL0:->RL1 SETCHTYP(RL0:=0) ...reset chain flag RL1==REL8CH; JR Z,AL1 ...go resolve 1-byte chain RL1==REL12CH; JR Z,AL3 ...ditto 12-bit chain RL1==ABS32CH; JR Z,AL_L ..." 32-bit chain . H->HEX =->code ...D->DEFINE if BITB DIAGSW,3 not zero then begin ...check for /DIAG output Putcon(); Put1(RL0:=';') end LDB @R7,#' ' ...put space at end of stuff in buffer RL0:=@(R3:=^BUFF); R3:+1 ...get first char if RL0='=' then begin ..  found LDL RR4,HIVAL[R13] ...(LOC) if carry then ...if back ref BKREF0() ...chk ch. type, NCODE->(LOC) else MRKREF() ...if defined end else begin ...if not found NOTFND0() ...mark undef, set ch. type, NCODE->(LOC) SUBL RR4,RR4 .ot zero then begin RL0==RL0; RET end if RH3:-1 zero then BITB RL3,7 RET DISP12~ ...calcs. (R7+1-(R3-OFFSET))/2 ->R3, checking for out-of-range ...(also zero high nibble of H); R7 unchanged DISP12A() ...get R7+1-(R3-OFFSET) TSTRNG12~ TSTRG12A(); RET Z='A' ...symbol reference JP NZ,CPH ISA2~ RL0:=@R3' ...get 2nd char. RL0=='1'; JR Z,ISA1 RL0=='3'; JR Z,ISA3 RL0=='L'; JR Z,ISAL if RL0='4' then begin LKUPA(); RL1:=REL16CH end else begin LKUPA() ...look up Id @R3; rets. R3,R13 at table entry, R..left is 16-bit chains: ...store R7 (NCODE or def. value) into places referenced by chain ...if RL1=REL16CH, then store rel. value RL6:=RL1 CPLLUP~ R7:->R4; R3->R5 ...R7=value of label ($); R3=addr of ref. if RL6=REL16CH then begin R3<->R7; R3:=DI.check for assembler type R1:=NEXTDE; PUSH R1 ...save source ptr CLRB @R7; R7:+1 ...put 0 at end to stop parsing R1:=FREE; PUSH R1 ...save stack top SAVX() ...save INSTLIST (@HL--DE) in user stack POP R7 ...recall start of INSTLIST in s..0 to mark end of chain end OREL16(R3:=R4); OREL16(R3:=R5) ...RR4->@R7, R7:+4 RET ...RL1=ref type, RR6=NCODE: BKREF0~ ...do when back ref. GETCHTYP(); RL0==RL1; JR Z,NF2 CPAMIX~ CALL Errm; DEFT 'MIXED REF' ... NOTFND0~ ...do when ref. not found SET; JR OORERR TSTRG12A~ ...do R3/2; ret NZ if out of 12-bit range HLDIV2() if RL0:=RH3|7+1 not zero then begin RL0:=RH3&0F8; RET NZ end RH3:&0F; RL0==RL0; RET DISP12A~ ...calcs. R7+1-(R3-OFFSET)->R3 DISP0() ...R3-OFFSET-(R7+1) R3:=-R3; RET DISP0~ ..5=orig R3 A2A~ ... if zero then begin ... if BIT TYPE[R13],EXTB not zero then begin ... ...if external symbol, make ref. instead to alternate symbol ... SETB @R5,5; LKUPe(R3:=R5) ...err if not defined ... end ... ...flag should be Z=1SP0()-1; R3<->R7 ...if rel-16, get diff. $-addr-2 in R7 end R3:=R5 RDBCaHL() ...contents current addr. in chain ->R1 WRDEaHL() ...store at addr. the approp. value R7:=R4 R1:&0FFFE; RET Z ...check for 1 (or 0) => end of chain R3:+R1 ...next tack CALL INSTLIST ...go parse statement POP R7 ...recall NEXTDE Ig() ...pop text from stack RL0:-RL0; RET ...1->Z end R1:=R7 LDL RR6,NCDSEG ...R6:=NCDSEG; R7:=NCODE if RL0=''' then begin ...string type repeat WRaDEi(RL0:=@R3) unti TYPE[R13],UNDEFB ...mark undef. SETCHTYP(RL0:=RL1) ...set chain type NF2~ LDL HIVAL[R13],RR6 ...NCODE->(LOC) RET CPH~ if RL0='H' then begin ...HEXADECIMAL type CPHLUP~ SPCMA(); RET Z ...chk if @HL=' ' or ',' Inhex() ...get 2 hex digits @HL co.do R3-OFFSET-(R7+1) ... R3:-OFFSET-1-R7; RET R3:-1-R7; RET GETSCP: ...get scope->RL0 RL0:=(@R13[TYPE]&0C0)/040; RET SETSCP: ...set scope (high 2 bits) of type word to RL0 RH0:=@R13[TYPE]&03F; RL0:*040; JR SETCS2 ... SETCHTYP: ...set chain type (bits ,C=from LKUP here ... end RL1:=ABSCH end if zero then begin ...if found R5:=@R13[LOVAL] ...(LOC)->R5 if carry then begin ...if back ref. BKREF0() ...chk ch. type, NCODE->(LOC) R3:=R5-R7 ...disp. to prev. ref. end else begin chain location ->R3 JR CPLLUP CKRDFERR~ ...chk if can redefine symbol; R13 at table entry, R7=new value if CPB BUFF,#'D' then begin GETTYP(); RL0==ADDRT; RET Z end ...ok to redefine ADDR type with "D" type R7==@R13[LOVAL]; RET Z ...ok to redefine wl R3:+1=R1; R7:->NCODE; JR OUTDUN end R3:-1; PUSH R1 repeat PUSH R3; RL0:=@R3; R3:+1 OUTCP() ...go handle data in buffer (RL0=1st char., R3 at 2nd) R7:->NCODE ...new NCODE POP R3; R1:=@R15 R1:-R3; JR Z,OUTX ...get remaining len. of datnverted to its value (->R.A) WRaDEi() ...put out byte JR CPHLUP end if RL0='O' then begin ...OR type RH1:=0 ...OR following pairs of hex digits together: while SPCMA() not do begin Inhex(); RH1:|RL0 end WRaDEi(RL0:=RH1); RET end if8-10) in type word to RL0 RH0:=@R13[TYPE]&0F8 SETCS2~ RH0:|RL0->@R13[TYPE]; R0==R0; RET ...ret Z=1 GETCHTYP: ...get chain type->RL0 RL0:=@R13[TYPE]&7; RET SETTYP: ...set lower nibble of type word to RL0 PUSH R1; R1:=@R13[TYPE]&0FFF0; RL1:|RL0; R1:->@...if defined MRKREF() ...ind. has been referenced R5:->R3 ...symbol value if RL1=REL16CH then begin DISP0(); R3:-1 end ...if rel-16 ref, get R3-OFFSET-R7-2->R3 =disp. to insert end end else begin ...if not found NOTFND0() ...maith same value ...(for now, ignore seg.) RDFERR: CALL Errm; DEFT 'REDEFINED LABEL' AL1~ ...1-byte chain will now be resolved PUSH R7 ...R7=value of label ($); R3=addr of ref. R3<->R7; DISP(); R3<->R7 ...get diff. $-addr-1 in RL0, checking for out-a R6:=NCDSEG RL0:=','; CPIRB RL0,@R3,R1,EQ until not zero; ...if "," in remaining data, repeat starting after it OUTX~ POP R1 OUTDUN~ R7:=NEXTDE RL0==RL0; RET OUTCP~ ...checks 1st char. & then does the appropriate ops. on data in buffer if RL0=' RL0='W' then begin ...OR type for words R1:=0 while SPCMA() not do begin Inhex(); RH1:|RL0 Inhex(); RL1:|RL0 end WRBCaHL(R3:=R7); R7:+2; RET end if RL0='R' then begin ...rel. nn type RL0:=@R3'; PUSH R0 R3:=InhexW()-1->R1 .R13[TYPE]; POP R1 RET GETTYP: ...get lower nibble of type word->RL0 RL0:=@R13[TYPE+1]&0F; RET SETVAL: R3->@R13[LOVAL]; RET ...R3->symbol value GETVAL: LDL RR2,HIVAL[R13]; RET ...symbol value->RR2 MRKREF: RES TYPE[R13],REFB; RET ...mark symbol referenrk undef, set ch. type, NCODE->(LOC) R3:=1 ...1 to mark end of 16-bit chain end OREL16~ R3<->R7; WRDEaHL(); R3<->R7 ...put out R3 at R7 R7:+2; RET ISA1~ LKUPA() A1A~ RL1:=REL8CH if zero then begin ...if found R5:=@R13[LOVAL] ...(LOC) if caof-range POP R7 ...$ RL0:->RH0 RDaHL(); RL0:->RL1 ...contents of current addr. in chain ->RL1 WRaHL(RL0:=RH0) ...store at addr. the calculated rel. displacement RL1==0; RET Z ...check for 0 => end of chain BITB RL1,7; JP Z,OORERR_ ...error if chC' then begin ...CALL type if begin LKUPA(); RH0:=flag; PUSH R0 end not zero then begin ...if not found: DOCALR~ POP R0; RH0:->flag; WRaDEi(RL0:=0D0); JP A3A ...do CALR ref. end ... ...note: save R5 from LKUPA for A2A if c..R1=NN-1 R3:-R7; POP R0 if RL0='1' then begin TSTRNG(); JP OREL8 end ...NN-($+1) if RL0='4' then begin R3:-1; JP OREL16 end ...NN-($+2) R3:=R7-R1 if RL0='3' then begin TSTRNG12(); JP OREL12 end ...$+1-NN RL0:->RH1; TSTRNG(); BITB RL0, ced CKABADRT: ...chk type=abs. addr (not based, equ, or reg) GETTYP() if RL0<>BASBYTT and RL0<>BASWRDT and RL0<>EQUT then RL0==REGT COMFLG Z; RET NDFERR: CALL Errm; DEFT 'NOT DEFINED' LKUPA~ if NCDFLG<>0 and RL0:=@R3>='A' then begin ...LKUPe~ S_LKUnot global end end BIT TYPE[R13],ZAPB; JR NZ,PKLUP ...skip if zapped RL0:=@R13[LNGTH]; R3:=R13+NAME ...for HASHER R2:=R11 LDIRB @R11,@R13,R1 ...move old entry to new table HASHER() ...base of table + HASH = 1st link -> R3 R2:<=1 SET TYPE[R13],ZAPB ...mark zapped RL0:=@R13[NAME+1] ...low-order no. in name (high-order is 0) ASCtoN() ...convert RL0 to its value ...Note: this routine will have to change to include high-order no. in name if ... no. of temporary symbols increa...save it R3-LINK->R13 ...pt. to appropriate base link-LINK RH2:=RL5 ...len LKLUP~ repeat R7:=@R13[LINK] R7==0; JR Z,LKEND ...end chain R13:+R7 until R2=@R13[LNGTH]; ...chks len. & 1st char. R3:=R13+(NAME+1) ...pt. R3 to name+1 R7:=R6 ...ROC ...compare name pointed to by DE to name pointed to by HL ...enter HL,DE at NAME in symbol tbl (LNGTH before); preserve HL,BC,DE RL0:=@R7==@R3; RET NZ ...cmp. 1st char. PUSH R1; PUSH R7; PUSH R3 R3:-1; R7:-1 if RH1:=@R7>@R3 then RH1:=@R3 ...min.PNL(); JR NZ,NDFERR; JR C,NDFERR; RET ...if imm. ex. then symbol (exc. tmp.) must be defined end S_LKUP(); RET ...ret. R5,R13 ...EXTSUB: PROC ...handle symbol in external stmt. (set so will be abs. refs.) ... if Lkup(W.LASTDE) not then begin ...i->R13 LINKER() ...link @R3->here; here->prev. link @R3 (R13=^new entry) R13:=R2 end TABLEN(R7:=R11) ...store len. of new table at TABBSE POP R11; POP R7; RL0==RL0; RET Nxtsym: PROC ...steps through symbol table by hash codes and links ...if RLsed to more than 16 RL1:=RL0; RH1:-RH1 ...symbol value->R1; 1->Z ...res. bit in table marking temp. symbols as used or not: RESB TMPTAB[R1],0 ...note: GENCLN (in Gen) resets bits 1 RET SAVN: OUTHRL() ...save a one-byte number in RL3 on stack; fall source starting char. R1:=R5 if R1:-1 not zero then begin R7:+1 CPSIRB @R7,@R3,R1,NZ; JR Z,LKLUP end BIT TYPE(R13),ZAPB ...check if zapped JR NZ,LKFIN BIT TYPE[R13],UNDEFB ...Z=1 if symbol defined JR Z,LKEXIT0 ...OK, Z=1,C=0 SETFLG Z,C ... len.->RH1 RH0:=flag repeat R3:+1; R7:+1 ...cmp. chars. in name if RL0:=@R7<>@R3 then begin POP R3; POP R7; JR CPNX end until RH1:-1 zero; POP R3; POP R7 RH0:->flag ...flag from len. comparison CPNX~ POP R1; RET ...PutOut~ ...put out Map entriesf not found ... SET TYPE[R13],UNDEFB; RL0==RL0; RET ...ABSCH is set by default ... end ... RET NC ...if found & defined ... GETCHTYP(); RL0==ABSCH; RET Z ... RL0==REL12CH; RET NZ ...error if rel. chain other than 12-bit ... PUSH R7; PUSH R3 ... AL3(@R0=0 then returns first symbol first chain, else returns next ... symbol same chain (then next chain) ...returns Z=1, R13 at symbol tbl entry if found; Z=0 if at end ...preserves regs<>R0,R3 PUSH R1 if RL0=0 then begin RL0:->Hash; R3:=TABBSE+2 end elsthru: ... Sav: PROC ...puts bytes from ^BUFF to R7, then count, in STACK starting ...at W.FREE; W.FREE updated; DE pointed again to source SAVX(R3:=^BUFF) JP OUTDUN ...NEXTDE->R7; 1->Z; RET ... SavB: Outset(); Outhex(); JR Sav ...save RL0 in hex SAprev. ref: Z=1,C=1 JR LKEXIT LKEND~ R8==0; JR NZ,LKEXIT0 ...if don't want linked up (Z=0, C=0) R3:=TABBSE; R13:=R3+@R3 ...next free loc.->R13 R3:=(R7:=R13+NAME)+R5 ...new end of symbol table R3==ENDTAB ...test if room left in symbol table for new en, starting cols. 0,20,40,60 ... ...enter with R13 pointing to symbol tbl entry ... R7:=Nxtpos ... RL1:=@R13[LNGTH]; RH1:=0 ... if R7+R1>^BUFF+69 then begin PUSH R1; Outmsg(); Outset(); POP R1 end ... GETVAL(); HLout(); OutSP() ...put out symbol value ... 13[LOVAL]; R7:=NCODE) ...resolve chain ... POP R3; OUTJP() ...put out abs. jp to the label ... R7:->NCODE ... POP R7; R0==R0; RET ...... ...OUTJP~ RESFLG Z; RH0:=flag; PUSH R0; RH1:=8; JP DOJP ... ...8=jp always; flag(Z=0)=not found RESEXTSB: PROC ...e R3:=Link while begin ...get ptr. to link of next entry (R3+@R3->Link): R1:=@R3 R3+R1->Link; R1==0 ...Z=1 iff end of chain (@R3=0) end zero do begin if RL0:=Hash+1=NHASH then begin RESFLG Z; JR NxtsymX end RL0:->Hash; RL0:*2+2; RH0:=0 RVX~ ...saves from R3 to R7 on STACK R1:=R7-R3; RL0:=RL1 ...length->R1->RL0 R7:=FREE ...get dest. if not zero then LDIRB @R7,@R3,R1 ...copy bytes RL0:->@R7' ...save count R7:->FREE RET Re: PROC ...restore last item on stack to @R7+.. Ig() RE1~ Rtry JR UGT,TUMANY ...too many symbols RL5:->@R13[LNGTH] ...length of symbol name ...R6=^start of source symbol; R5=len. LDIRB @R7,@R6,R5 ...symbol name in table (R7->new end of symbols) R7:+1; RES R7,0 ...to even boundary TABLEN() ...store rel. lHLout(@R13[TYPE]); OutSP() ...put out type ... R3:=R13+NAME ... LDIRB @R7,@R3,R1 ...put out name ... R3:=^BUFF-1 ... repeat R3:+20 until R3>=R7; ... repeat OutSP() until R7>R3; ... if R7>^BUFF+79 then begin R7:-1; Outmsg(); Outset() end ... R7:->Nxtpos; reset EXTEND (symbol "EXTEND" @LASTDE..R7) Lkup(R3:=LASTDE); R1:=^EXTADR->@R13[LOVAL] LD TYPE[R13],2**UNDEFB; SETCHTYP(RL0:=ABSCH) LD @R1,#1; R0==R0; RET S_LKUPNL: PROC R5:=1; JR S_LKUP_ ...don't add to symbol table if not found ... S_LKUP: PROC R5:3:=TABBSE+R0 ...ptr. to next base link end R3:-LINK->R13 R3==R3 NxtsymX~ POP R1; RET Tstsym~ PROC ...tests symbol @R13 to see if not masked out (save regs<>0) ...chk MAPCMP, MAPMSK, MAPBEG & MAPEND PUSH R1 R1:=@R13[LOVAL] if R0:=MAPCMP.XOR.@R13[T1==0; RET Z LDIRB @R7,@R3,R1; RET Pp: PROC ...effectively pops to @DE+.. & pushes again (leaves on stack) RPI(); JR RE1 Ig: PROC ...pop last item from stack without putting anywhere ... ret. R1=len.; Z=0 RPI() R3->FREE ...adjust stack pointer RESFen. of table at TABBSE R3:=R4 ...base link LINKER() ...link up (R13 at new table entry) LKFIN~ R8==0; JR NZ,LKEXIT0 ...chk LINKSW; Z=0, C=0 R13->R3 ...table entry SUBL RR0,RR0; LDL @R13,RR0 ...00->(LOC) R0:->@R13[TYPE] ...clear type word RESFLGRET PutOut~ ...put out Map entries, starting cols. 0,26,52 ...enter with R13 pointing to symbol tbl entry, Nxtpos=curr. col. R7:=Nxtpos RL1:=@R13[LNGTH]; RH1:=0 if R7+R1>^BUFF+65 then begin PUSH R1; Outmsg(); Outset(); POP R1 end GETVAL(); GETTYP() =0 S_LKUP_~ ...expects R3 pointing to data ending with a ' ' or ',' ... R5=0 iff to add symbol to table if not found ...returns R3,R13 pointing to table entry ...Z=1 if found, CARRY=1 if referenced & not defined ...RR6 unchanged; ...R5=orig. R3 PUSH R YPE] & MAPMSK zero then begin if R1<=MAPEND and R1>=MAPBEG then R0==R0 end POP R1; RET NXTsym: PROC ...get R13 pointing to next symbol not masked out repeat Nxtsym(); RET NZ until begin Tstsym(); RL0:=1 end; RET Nm00~ BYTE 0 ...min. symbol alphabLG Z; RET RPI: ...ret. R3=^prev. string, R1=length R3:=FREE RPI2: R3:-1 RL1:=@R3 RH1:=0 R3:-R1 ...R3->first char. RET Xc: PROC ...swap top two, DE unchanged PUSH R7; PUSH R7 Re() ...1st string out PUSH R7 ...^ end 1st Re() ...2nd string out  Z ...set Z=0,C=0 LKEXIT0~ RESFLG C LKEXIT~ R13->R3 POP R8; POPL RR6 ...R7 after source symbol RET TUMANY: CALL Errm; DEFT 'TOO MANY SYMBOLS'; BYTE 0 TSTEND~ ...performs R13==(W.TABBSE+@2W.TABBSE) ...returns R1->end of symbols (ENDSYM); preserves reg...RR2=value, RL0=type if CKABADRT() then OutADR() else begin OutSP(); OutSP(); HLout() end ...put out symbol value OutSP() HLout(@R13[TYPE]); OutSP() ...put out TYPE R3:=R13+NAME LDIRB @R7,@R3,R1 ...put out name R3:=^BUFF-1 repeat R3:+26 until 7 R3->R7; ...PUSH R3 RH1:=080 ...limit to search repeat RL0:=@R7==' '; JR Z,S_LK2; RL0==','; JR Z,S_LK2; R7:+1 until RH1:-1 zero; ...R7 points to ' ' or ',' S_LK2~ Lkup_() ...POP R5 POP R7; RET LINKER~ ...expects : R3 at base link; R13 at new entretically NmFF~ BYTE 0FF ...max. symbol Map: PROC ...prints out symbols and values PUSH R7; Nxtpos:=^BUFF if MAPTYP<>'A' then begin ...do by order of occurrence: R13:=TABBSE+(NHASH*2+2) while TSTEND() COMMAND / LABELCOL COMMCR .DO(RET Z) INSTLIST) COMM / COMMCR ; LABLCMD~ := / LABELCOL ; LABELCOL := .SAV(*) {"(" .DO(CALL PARMLST)s<>R1,R3 R3:=TABBSE; R1:=@R3+R3 R13==R1; RET TABINT: ...set 1st 2 bytes @R3 = rel. disp. to init. table end position ...0's -> init. links (@(R3+2...)); ret. R3 at pos. for 1st entry R3:=TABBSE; R1:=2*NHASH+2->@R3; R1:-2 TBINT2~ R3:+2; RL0:=0; repeat R3>=R7; repeat OutSP() until R7>R3; if R7>^BUFF+77 then begin R7:-1; Outmsg(); Outset() end R7:->Nxtpos; RET Gen: PROC ...GENERATES NEW SYMBOL OF FORM 'NN'# ... CHECKING IF PREVIOUSLY CALLED AT THIS LEVEL POP R3 POP R1 ...prior return addr R1==^GEy ...performs: if @R3=0, 0->@R13[LINK] else @R3-[R13+LINK-R3]->@R13[LINK] ... [R13+LINK-R3]->@R3 ...returns : R13 unchanged R1:=@R3 R7:=R13+LINK-R3->@R3 if R1<>0 then R1:-R7 R1:->@R13[LINK] RET HASHER~ PROC ...generates hash code for lookup tsym(); if zero then PutOut() ...put out if not masked out RL1:=@R13[LNGTH]+(NAME+1); RH1:=0; RES R1,0 R13:+R1 ...pt. R13 to next symbol end end else begin ...do alphabetically: LastNm:=^Nm00 while GetLNm() zero do PutOut() end if R ")" SQCOL EVBDYLBR SETTYPS_P (.DO(CALL FUNC)) / SQCOL "=" EVBDYLBR SETTYPS_P (.DO(CALL QRULE)) / Del SETDLR Del ?";" / LABLRe {";"} .DO(RL0:=LABLT) SETTYPS} ; SQCOL~ := .DO(RL5:=0) {"~" .DO(RL5:=1)} .DO(RL5:->SCPFLG) Del ":" ; INSTLIST := (RL0:->@R3' until R1:-1 zero; RET TABLEN~ ...enter with DE at end of symbols; store rel. len. of table @2TABBSE R3:=TABBSE; R7:-R3->@R3; RET PAKALL: PROC RL0:=1; JR PK1 PACK: PROC ...pack symbol table RL0:=0 PK1~ RL0:->PAKSW PUSH R7; PUSH R11 R1:=2*NCLN; JR Z,GEN2ND PUSH R1 PUSH R3 ^TMPTAB; RH1:=16 ...16 poss. temp. symbol values repeat ...chk table marking temp. symbols as used or not TESTB @R3; JR Z,GENOK ...0 means not used R3:+1 until RH1:-1 zero; TUDEEP~ Errm(); DEFT 'OVER NESTED' able ...expects RL0 with symbol length; symbol @R3 ...returns code*2+2 in R7, init. link in R3 RL0:-1; RL0:=@R3 if not zero then RL0:*4.XOR.@(R3:+1) RL0:&(NHASH-1) RL7:=(RL0+1)*2; RH7:=0; R3:=TABBSE+R7; RET Lkupnl: PROC ...Lkup but don't link in sym7:=Nxtpos<>^BUFF then Outmsg() ...if not 1st col, put out last line Icopy(); DEFT 'Rem Space='; BYTE 0 TSTEND() ...get R1=^end of symbols R3:=ENDTAB-R1 ...calc. remaining space HLout(R3); Outmsg() ...print Rem Space=hhhh POP R7; R0==R0; RET GetLNm.DO(CALL ZINST)) $(Del ";" .DO(CALL ZINST)) ; SLASHST~ := "/" / "*" ; COMMCR~ := COMM .DO(CPB @R7,#0D) ; COMMAND := CMD1 / IMMX ; CMD1 := CMD2 := ("DO " .DO(DOFLG:=0) / "LOAD " .DO(DOFLG:=1)) Del .DO(PUSH R7) NOTCR LISTCHK .DO(POP LASTDE) NEWFIL := "PANHASH; TBINT2(R3:=TABBSE) ...zero init. links, get R3=^1st symbol R3->R13->R11 ...R13 pts. at old table, R11 at new JR PK2 PKLUP~ R13:+R1 PK2~ while TSTEND() @R7' JP @Rbol if not found R5:=1; JR LKUP_ ... Lkup: PROC R5:=0 Lkup_~ LKUP_~ ...expects: R3 pointing to first source character ... R7 pointing after last source character ... R5=0 iff to add symbol to table if not found ...returns: R3,R13 pointing to ~ ...get least name>LastNm pointed to by R13 (@LOC) & LastNm (@NAME) ...ret. Z=1 iff find any R1:=^NmFF; RL0:=0 ...current least name stored in R1 while NXTsym() zero do begin R3:=R13+NAME ...R3 pts. @NAME of next entry R7:=LastNm ...last symboCK" Del {"ALL" MASK PAKALL / MASK PACK} := "IMAGE" Del .DO(PUSH R7;repeat RL0:=@R7' until RL0=' ' or RL0=0D;R7:-1) FINBUF .DO(R3:=0FFFF->E_ADD->E_SEG;SDesPs:=^SegDes) $ .DO(0->R3->R5) SDesSb2 .DO(POP LASTDE) IMGSUB := ORG ... :1,0 ...len of entry->R1 if BIT TYPE[R13],UNDEFB zero then begin ...save undef'd symbols Tstsym(); JR NZ,PKLUP ...skip if masked out if PAKSW=0 then begin ...chk if packing just globals GETSCP(); RL0==GLOBSC; JR NZ,PKLUP ...skip if 3 GENCLN~ POP R1; RH1:=0 ...clean up stack; temp. symbol value->R1 RESB TMPTAB[R1],1 ...note: Zp resets bit 0 RET ...note: GENCLN must preserve Z-flag Zp: PROC ...mark tmp. symbol zapped in symbol table (@R13) ...reset bit 0 in TMPTAB entry; ret. Ztable entry ... Z=1 if found, CARRY=1 if referenced & not defined ... RR6 unchanged PUSHL RR6; PUSH R8 R6:=R3; R8:=R5 ...R8=LINKSW R5:=R7-R3 ...R5=length of symbol RL2:=@R3 ...RL2=1st char HASHER(RL0:=RL5) ...get R3=^init. link R3->R4 l put out if CPName() LastNm R7:=R1 ...current least name if CPName() >=zero then R3->R1 ...new least name end RL0:=1 ...for NXTsym end R1:->LastNm; R13:=R1-NAME R1==^NmFF; COMFLG Z; RET CPName~ P = "EXTERNAL" $(Del ) := "EOF" FILDUN := "START " JPNEW := "BRKS->" ("Y" BRKStoQ / "P" BRKStoP) := "RESET" Del "EXTEND" RESEXTSB := "CLEAR" TABINT ; CMD2~ := SETDLR "SEG" .DO(SEGMD:=1) := "NONSEG" .DO(SEGMD:=0) := "MAP" .DO(ifO(if RL0:=@R7=0D then RL0:|RL0 else begin RL3:=RL0;RH3:=0;R7:+1;if CPB @R7,#''' then R7:+1==R7 end))) SAVKW := "$" .DO(LDL RR2,DOLLAR) SAVKL := .DO(CONSW==0;JR NZ,N22) "(" ")" := "@" ReK .DO(if BIT R2,15 zero then R2:=NCDSEG;RDR1aRR2();s, ... runseg->@(^SegSegs+(SDesPs-^SegDes)/2) ...ncdseg->@(^runseg+(^SegSegs2-^SegSegs)) R0:=NCDSEG if BITB RL1,7 zero then begin if BIT R4,15 not zero then R0:=R4 end else RH0:=RL1 ...R0=ncdseg for seg RL1:=0 if BITB RH1,7 zero then begin R1(POPL RR4;R2:=@R13[HIVAL];if RL5=ADDRT and RH4=RH2 and RL2=0 then RL4:->@R13[HIVAL+1];R0==R0) ; ...ADDR~ := { ReK .DO(RH3:=RL3;RL3:=0;SET R3,15;PUSH R3) .DO(POP R3;RL0:=1) ... / .DO(W.RUNSEG;RL0:-RL0)} ; ...ret. RL0<>0 iff segReK ; SKIP~ Skip==0; RET NZ ...don't skip if <>0 CPB @R7,#'/'; COMFLG Z; RET NZ ...don't skip if at '/' NOTCR~ CPB @R7,#0D; RET Z; R7:+1; JR NOTCR ...IdDEFAB := CKDEFAB ; ...SAVHL := .SAV(HLout) ; SAVKW := .DO(R2:=0) SAVKL ; SAVKL := .SAV("K"OUT RL0:=@R7='A' then R7:+1; RL0:->MAPTYP) MASK Map := "ZAP" Del {ZAPALL / $(Del )} := "LIST" Del {"OFF" .DO(RESB DIAGSW,6) / "ON" LSTINT / Quit2 {"END" / LSTINT ?( LFILOPN Outset O_VERSN Outp NOTCR)}} := "IF " IMMXIF .DO(RL0:->RL4) R3:=R1) SAVKW ; N22~ := .DO(PUSH R7) "(" { {")" .DO(POP R3) / Ig}} := .DO(POP R7) ; ZNN2I := ZN2INCS SVCALC ; SVCALC~ := .SAV(CalcN) ; HXNN2I := HXNI / NN2I ; NN2I := N2ICALC ; N2ICALC~ := N2INCS SVCALC ; HXNI := Del SAVKW N2ICA:=RUNSEG; if BIT R4,15 not zero then R1:=R4 end ...R1=runseg for seg R3:-R5; RET C ...chk end not before beg. (not chking seg. matches) R3:+1 SDesSb2~ ...enter here with R5 (beg adr) & R3 (len) as going in des. ...if len<>0, R0=ncdseg, R1=runseg R4:. given ADDR~ := { ReK .DO(RH3:=RL3;RL3:=0;SET R3,15;PUSH R3) ReK .DO(POP R2) SAVKL .DO(RL0:=1) / ReK .DO(if BIT R2,15 zero then R2:=RUNSEG;if BIT R2,7 zero then RL2:=0) SAVKL .DO(RL0:-RL0)} ; ...ret. RL0<>0 iff seg. given DRR2) ; SAVNN := .SAV("H"HLout) ; SVNNCMRe := .SAV("H"HLout","Re) ; OUTRE := .OUT(Re) ; LABLRe := .OUT("L"Re) ; LABLReZ := LABLRe Zp ; SVLAB := .SAV(#1) ; COMM := Del ?("..." NOTCR) ; ELSEST2 := .OUT("J08"#1) LABLReZ .SAV(#1) ; W_DOT := "W." CKNOTDOT ; B_DO"THEN" .DO(RL4:->Skip) := "ELSE" .DO(RL0:=1-Skip->Skip;R0==R0) := "ENDIF" .DO(Skip:=1) := "WRITE" WWDATA $("," WWDATA) Outset Outlin := "GLOBAL" $(Del GLBSUB) := "DIAG" .DO(SETB DIAGSW,3) := "*" Quit1 .DO(JP Debug0) := "/" RETSYS ; MASK~ := .DOLC ; ...ORGNN~ := ( CKADDR) SAVKW ... .DO(if R2:=@R13[HIVAL]<>RUNSEG then begin if RL2=0 then RL2:=RH2;RH3:=RL2;RL2:=0;R2:->RUNSEG;RL3:=0;R3->NCDSEG end) ... N2ICALC ... := ?(.DO(if RL0<>0 or R3<>RUNSEG then R3->RUNSEG->NCDSEG)); HXNN2Ie := HX=SDesPs RL5:->@R4'; RH5:->@R4' ...store beg. adr. RL3:->@R4'; RH3:->@R4 ...store len. R4==^SegDes+(4*12); RET UGT ...chk not >12 segs (Z=0), ok last time SDesPs:+4 R4:=(R4-(^SegDes+3))/2+^SegSegs ...^SegSegs+ R1:->@R4 R4:+(^SegSegs2-^SegSegs) .EFIT~ := DEFINE .DO(EQUFLG:=1;GETVAL()->W.EQUVAL) ; DEFAT~ := Del "at" DEFIT ; ARRAY~ := "ARRAY" ; SETTYPS_P~ RL0:=PROCT ...fall thru: SETTYPS~ := SETTYP .DO(if SCPFLG<>0 then SETSCP(RL0:=TMPSC)) ?() ; EVBDYLBR~ := .DO(R3:=NCODE+1;RES R3,0;R3->NCODT := "B." CKNOTDOT ; ONEDOT := "." CKNOTDOT ; CONT~ ...checks if R7 not at CR & line up to R7 just has Dels CPB @R7,#0D; COMFLG Z; RET NZ R7:->R5; R7:=LASTCR; Del() R7==R5; R7:=R5; RET NZ R7:=LASTCR; RET ZAPASUB: RL0:=0 ...zap all symbols not masked(MAPBEG:=0;MAPEND:=0FFFF) RANGE {Del "TMPS" .DO(LDL RR2,#TMPSC*SCSHFT,3*SCSHFT) / "UNDEF" .DO(LDL RR2,#2**UNDEFB,2**UNDEFB) / {GETNUM / .DO(0)} .DO(PUSH R3) {GETNUM / .DO(@R15)} .DO(POP R2)} .DO(R2:&(-(2**ZAPB)-1)->MAPCMP;SET R3,ZAPB;R3->MAPMSK) RANI / NN2Ie ; NN2Ie := NN2I / CKNDFERR ; CKNDFERR~ if CPB @R7,#'^' <> then begin Id(); RET NZ end JP NDFERR ...do NN2I, put out error msg. if fail because of undef'd label ZN2INCS : RL0:=1; JR N2INCSA N2INCS : RL0:=0 ...drop thru: N2INCSA~ := .DO(RL0:-..^SegSegs2+ R0:->@R4 R0==R0; RET GLBSUB~ if Lkup(W.LASTDE) not then SET TYPE[R13],UNDEFB ...if wasn't in table SETSCP(RL0:=GLOBSC); R0==R0; RET ...mark global in symbol table ZAPSUB~ LKID(); JR C,NOGD_ ...look up id, error if ref. but not def'd iE) SETDLR LABLRe ; ...DEFINE := ReK .OUT("D"HLout Re) ; DEFINE := ReK .OUT("D"OuthexL Re) ; SETDLR := .DO(R2:=RUNSEG;R3:=NCODE;LDL DOLLAR,RR2) ; IdLN := .DO(R3:=LASTDE<->R7;RL0:=RL3-RL7==RL0) ; ...ret R3 at end BNR := UPNCD := $( SAV out while NXTsym() do begin if BIT TYPE[R13],UNDEFB zero then SET TYPE[R13],ZAPB RL0:=1 end R0==R0; RET Patchsub: ...enter with RR4=HOLE, RL6=PATCHN, RH6=PATCHR ...PATCHN=#bytes @HOLE to move (PATCHR=0) or skip (PATCHR=1) ...chk for INSTLIST, NGE ; RANGE~ := Del "R=" { .DO(R3->MAPBEG)} ?("," ?( .DO(R3->MAPEND)) / .DO(MAPBEG->MAPEND)) ; ZAPALL~ := .DO(IdLN();RET NZ;RL0==3;RET NZ) "ALL" MASK ZAPASUB ; FNMCHR : RL3:=@R7=='0';RET ULT; RL3=='z';RET UGT; R7:->LASTDE;R0==R0;RET LSTINT~>CONSW) $(N2INC1 / N2INC2) ; ZNNTRM := .DO(PUSH R7) $ .DO(POP R3;if RL0<>0 then begin R3<->R7;Ig();RET end) := .DO(POP R3) ; N2INC1 := Del .DO(PUSH R7) (.DO(if RL0:=@R7='+' or RL0='-' or RL0='&' or RL0='|' then R7:+1==R7)) {(.DO(PUSH R0;ZNNf zero then SET TYPE[R13],ZAPB ...mark zapped R0==R0; RET CKNOTDOT: CPB @R7,#'.'; COMFLG Z; RET Z NOGD_~ NOGD~ RESFLG Z ...back up over id, set Z=0 R7:=LASTDE; RET ... IdCOL~ Id(); RET NZ; CPB @R7,#':'; JR NZ,NOGD ...chk for id followed by ':' CKDEFN WBLRG) ; WNR := .DO(R3:*2) UPNCD := $( WBLRG) ; LNR := .DO(R3:*4) UPNCD := $( WBLRG) ; ...ORG := "ORG" Del ReK .DO(R3->NCODE) ; ORG := "ORG" Del .DO(PUSH R0) ReK .DO(R3->NCODE;POP R0;if RL0then put out JP's PUSH R6; PUSHL RR4 R3:=NCODE; PUSH R3; INSTLIST(); POP R3 POPL RR4; POP R0; PUSH R7 R2:=RUNSEG; LDL RR6,NCDSEG ...(R7:=NCODE) PUSHL RR4; PUSHL RR2 ...RL0=PATCHN, RH0=PATCHR repeat if RH0=0 then begin RDR1aRR2(LDL RR2,RR4); : SETB DIAGSW,6; EQUFLG:=0; LSTLAB:=0FFFF; RET ...SEGADR_E~ := Del "E=" .DO(RL3:<->RH3;R3->E_ADD;if BIT R2,15 not zero then R2:->E_SEG;R0==R0 ... := SEGADR ; SEGADR_E~ := Del {IdCOL / .DO(R2:=0)} .DO(R2:->RGNSEG) .DO(PUSHL RR2) RR2 MRKREF() ...mark referenced R0==R0; RET ... CKDEFCON~ ...chk for def'd<>0 then RL2:=RH2) .DO(if R2<>RUNSEG then begin if RL2=0 then RL2:=RH2;RH3:=RL2;RL3:=0;R3->NCDSEG;RL2:=0;R2:->RUNSEG end;R0==R0) ; DEFX := "DEFS" Del UPNCD := "DEFT" Del OCSTARI := "DEFM" Del OUTSTARI ; OCSTARI~ := .O WRR1aRR2(LDL RR2,RR6); R7:+2 end R5:+2 until RL0:-1; ...move PATCHN words from HOLE to after instlist code OUTJPN(LDL RR2,RR6); R3->NCODE ...put in JP HOLE+PATCHN POPL RR4; POPL RR2; OUTJPN() ...put JP Patch at HOLE POP R7; R0==R0; RET OUTJP1> .DO(POPL RR4;R1:=RGNSEG) ?(Del "E=" .DO(E_SEG:=RUNSEG) .DO(RL3:<->RH3;R3->E_ADD;if BIT R2,15 not zero then R2:->E_SEG;R1:=RGNSEG) .DO(if BIT R1,15 not zero then begin RL1:=0;R1:->E_SEG end) {Del "T=N" .DO(RES E_SEG,15)}) ; CO if fail because no '*',etc; RL0=1 if no N2 ...ZWNUM~ := SAVKW / "$" .DO(LDL RR2,DOLLAR) SAVKL ; SVXRRA~ := .DO(PUSH R0) .SAV(Xc Re Re .DO(POP R0;RL0:->@R7')) ; ...IdDEFCON := ("^" {IdDEF / .DO(R7:-1;RESFLG Z;RET)} / .DO(if CONSW=0 then CKDEF() & EQUT,ADDRT,LABLT, or ARRAYT else backup CKDEF0(); RET NZ GETTYP(); RL0==EQUT; JR Z,CKNOTBP; RL0==LABLT; JR Z,CKNOTBP RL0==ADDRT; JR Z,CKNOTBP; RL0==WARRAYT; JR Z,CKNOTBP RL0==BARRAYT; JR NZ,NOGD ... CKNOTBP~ ...chk not followed by "[" / "(" if RL0:UT("'" Cnt) OUTSTARI ; OUTSTARI := .OUT("'" *) .DO(R7:+1==R7) ; UPNCD~ := .DO(R3+NCODE->NCODE;R0==R0) ; SREND := OCSTARI EVNBDY0 ; EVNBDY0 := .DO(BIT NCODE,0) / .OUT("H00") ; Dzero := Del ?"zero" ; Test: JP TEST Del: JP DEL Icopy: JP ICOPY Copyin: JP COPYN~ ...put out JP (RR4) at (RR2); update RR2 WRR1aRR2(R1:=05E08); R3:+2 if SEGMD<>0 then begin WRR1aRR2(R1:=R4); R3:+2 end WRR1aRR2(R1:=R5); R3:+2; RET ...SDesSub~ ...store seg. descriptors, chk errors; enter: BC=beg adr, HL=end adr ... ...as goes on deNDIF~ := .DO(CALL ZSSEXPR) .OUT("HC801") ELSEST2 .OUT("HC800") LABLReZ ; WWDATA~ := ( .DO(PUSH R7) ReK Outset HLout ?() / .DO(R7:+1->stk-1) Outset ?) Outbuf .DO(R7:=stk==R7) ; EQUWBP~ := .DO(IdLN();RET NZ;RL0==4;JR Z,ADRWBP;RL0==3; else CKDEFCON())) SAVKW ; IdDEFCON := {(W_DOT / B_DOT) .DO(JP NOGD)} ("^" { CKDEFAB / .DO(R7:-1;RESFLG Z;RET)} / .DO(if CONSW=0 then CKDEF() else CKDEFCON())) SAVKL ; HEXN := .DO(R7:-1) HNum ; VALUE~ := "value(" .DO(PUSHL DOLLAR) IMMX =@R7<>'[' then RL0=='(' endif; JR NZ,CKDEF2; JR NOGD ... CKDEFAB~ CKDEF0(); RET NZ ...chk for defined & adr (not based, equ, or reg.) CKABADRT(); JR NZ,NOGD; JR CKDEF2 ... GETTYP(); RL0==BASBYTT; JR Z,NOGD; RL0==BASWRDT; JR Z,NOGD ... RL0==REGT; JR Z,NOGIN Copy: JP COPY Outset: JP OUTSET Out: JP OUT OutN: JP OUTN Sav: JP SAV SavB: JP SAVB Gen: JP GEN Zp: JP ZP Err0: JP ERR0 NBR := "0" HNum / Num ; ...HXWNSV := SAVHL N2INCS .SAV("H"Calc) / WNSV ; HXWNSV := ReK SAVNN / IdSV ; WNSV :s. record->@SDesPs, where imaged from->@(SDesPs+SDDIF) ... R3:-R1; RET C ...chk end not before beg. ... R3:+1 ...SDesSb2~ PUSH R7 ...enter here with R1 & R3 as going in des. ... PUSH R3 ...seg len->stack ... R3:=SDesPs; R7:=R3+SDDIF ...R3=SDesPs, R7=SDRET NZ) "EQU" DEFIT .DO(RL0:=EQUT) SETTYPS ; ADRWBP~ := "WORD" { .DO(RL0:=WORDT) / EVBDYLBR .DO(PUSH R13) { WNR .DO(RL0:=WARRAYT) / WNR .DO(RL0:=WORDT)} .DO(POP R13)} SETTYPS := "BYTE" { .DO(RL0:=BYTET) / LABLRe .DO(PUSH R(.DO(POPL DOLLAR;if CPB @R7,#')' then R7:+1==R7)) ; GETNUM := ReK / .DO(R7:-1) HNum .DO(R2:=0) / CKNDFERR ; ...GETNUM := Del HEXN / ReHL / VALUE ; GETADR1 := {.DO(PUSHL RR2) .DO(POPL RR4;RH2:=RL5;SET R2,15D; JR CKDEF2 ... CKADDR~ CKDEF0(); RET NZ ...chk ADDR type / backup GETTYP(); RL0==ADDRT; JR NZ,NOGD; JR CKDEF2 LKIDTYP: ...look up last id & get type->RL0 (0FF if undefined) ...mark ref'd if defined LKID() GETLKTYP~ RL0:=0FF if zero and not carry th= ReK SAVNN / IdSV ; IdSV := SVA2ST ; SVA2ST := .SAV("A2"*) ; LNSV := {"," EXC ReK SVNNCMRe / ReK .SAV("H"OuthexL)} := .SAV("AL"*) ; GETNN := ReK ; ZNN2 : RL0:=1; JR NN2A NN2 : RL0:=0 ...drop thru: NN2A~ : RL0:->CONesPs2 ... RL1:->@R3'; RH1:->@R3' ...store beg. adr. ... PUSH R3; R3:=IOFFSET+R1 ... R3<->R7; RL7:->@R3'; RH7:->@R3' ... POP R7; POP R1 ... RL1:->@R3'; RH1:->@R3'; R3<->R7 ... RL1:->@R3'; RH1:->@R3' ...store length ... POP R7 ... R1:=^SegDes+(4*12)+1 ... 13) { BNR .DO(RL0:=BARRAYT) / BNR .DO(RL0:=BYTET)} .DO(POP R13)} SETTYPS := "LONG" {DEFAT / EVBDYLBR .DO(PUSH R13) LNR .DO(POP R13)} .DO(RL0:=LONGT) SETTYPS := "PROC" { SETTYPS_P / EVBDYLBR SETTYPS_P} := "ADDR" LKUPPp .DO(RL3:=RL0;PUSHL ) / .DO(POPL RR2)} .DO(RL2:-RL2) ; GETADR := ?(.DO(if BIT R2,15 zero then R2:=NCDSEG)) ; INSTGRP0 := { LABLCMD} INSTGRP ; INSTGRP := $( { ?} / ?) ; XCOMM := COMM ENDLINE ; ENDLINE~ := .DO(CPB @R7,#en begin GETTYP(); MRKREF() end RL0==RL0; RET LKID~ ...look up Id in symbol table without linking in (get flag) Lkupnl(W.LASTDE); RET LKUPRe: ...Re & look up symbol; ret. R3=value PUSH R7; Outset(); PUSH R7; Re(); Lkupnl(POP R3); GETVAL() POP R7; RETSW ...drop thru: N2~ := Del IdDEFCON := .DO(PUSH R7) ("2**" { .DO(POP R3) .SAV(Re"^") / .DO(POP R7;RET)} / "-" { .DO(POP R3) .SAV(Re"~") / .DO(POP R7;RET)}) SVCALC := .DO(POP R7) (NBR / "$" .DO(LDL RR2,DOLLAR)) SAVKL := (VALUE / "'" (.DR3==R1; RET NC ...chk not >12 segments (Z=0) ... R3->SDesPs ... R0==R0; RET SDesSub~ ...store seg. descriptors, chk errors ...enter: RR4=beg adr, RR2=end adr, RH1=runseg, RH2=ncdseg (if segs=0, ... use RUNSEG, NCDSEG) ...as goes on des. record->@SDesPRR2) DEFIT .DO(RL0:=ADDRT) SETTYPS ... := "ADDR" LKUPPp .DO(RL3:=RL0;PUSHL RR2) .DO(PUSH R3) DEFIT .DO(POP R3;R3:->@R13[HIVAL]) .DO(RL0:=ADDRT) SETTYPS {Del "in" .DO(PUSH R13) ReK .DO(SETB RL3,7;POP R13;RL3:->@R13[HIVAL+1])} .DO0D;RET NZ;LISTCHK();R7:+1;NCODE->LSTNCD) Getrec ; XCOMS := $ ; LISTCHK~ := .DO(if BITB DIAGSW,6 not zero then LIST()) ; XMETA := $((.DO(R3:=UCCADR) Latch2 / SKIP) / CONT / ENDLINE / Err) ; RPTCNT~ := Del "[" "]"   LKUPPp~ ...get type of symbol on STACK->RL0, whole value->RR2 PUSH R7; Outset(); PUSH R7; Pp(); Lkupnl(POP R3); GETLKTYP() GETVAL() POP R7; RET OUTPP~ := .OUT(Pp) ; WBLRG~ if RPTCNT() not zero then R3:=1 ...R3=repeat cnt. R3:+1 while R3:-1<>zero d=0 S_LKUP_~ ...expects R3 pointing to data ending with a ' ' or ',' ... R5=0 iff to add symbol to table if not found ...returns R3,R13 pointing to table entry ...Z=1 if found, CARRY=1 if referenced & not defined ...RR6 unchanged; ...R5=orig. R3 PUSH R->R13+1; COMFLG Z POPL RR6; RET DNAM~ PROC ...same as PRTNM except pads with spaces into a fixed format 1+MAXNL+4 R1:=R7+(MAXNL+5); PUSH R1 PRTNM() POP R1; R1:-R7; COPYSP(RH1:=RL1) RET PRTNM~ PROC ...entered with addr. in RR2 ...prints name of mo->NCDFLG; RET NZ R2:=NCDSEG PUSH R7; GO_RR2(); POP R7; R0==R0; RET GO_RR2~ PUSHL RR2 ...fall thru: ... GOX: ...go to addr (long word) on stk (seg/nonseg) with same regs. & flag ... (if nonseg'd on diff. seg., assign default SP, save current) PUSHL RF+1;RL4:=0) $( ASCtoN .DO(RL0:->RL5) ASCtoN .DO(RL5:*16+RL0->@R3';RL4:+1==RL4)) .DO(POPL RR2;RL4==0;RET Z;LDB BUFF,RL4) LOCSUB := .DO(RL3:='N') NS2 .DO(LDB @R3,#1) := .DO(RL3:='S') NS2 .DO(LDB @R3,#2) ; ... := .DOo begin PUSH R3; OUTPP(); POP R3 end Ig(); R0==R0; RET ...SC_CALX~ EQU 014 ...SC to call external ...OJP~ := .OUT("J08"Re) ; ...OEXTREF~ := .DO(OutN();WORD 2;BYTE 07F;BYTE SC_CALX) .OUT("AL"Re,"H9E08") ; ...EXTSUB~ ...make external ref. to last Id ... 7 R3->R7; ...PUSH R3 RH1:=080 ...limit to search repeat RL0:=@R7==' '; JR Z,S_LK2; RL0==','; JR Z,S_LK2; R7:+1 until RH1:-1 zero; ...R7 points to ' ' or ',' S_LK2~ Lkup_() ...POP R5 POP R7; RET LINKER~ ...expects : R3 at base link; R13 at new entrst recent symbol + disp. to current pos. at R7 OutSP() ...out 1 sp. PRTNM2~ ...ret. Z=1 iff Name found ... PUSH R1; PUSH R3 if Name() and RH1=0 then begin ...Name rets. R1=disp. R1:->R2 ...save displacement in R2 R3:=R13+NAME ...R3 pts. to R2; LDL RR2,R15[4] ...get addr SET R2,15; RL2:=0 LDL GO_PSPC,RR2 ...put in prog. status vector R3:=flag if SEGMD<>0 then SET R3,15 R3->GO_PSFC ...set flag word for execution R3:=DEFSP if not zero or R2=QSEG then begin R2:=QSEG; R3:=R15+8 end LDL(RL3:='T') Tr2 .DO(LDB @R3,#3) ... := .DO(RL3:='U') UNASM CHK1SP~ RL1:=' ' ..."A "/"a " CHK1C(); RET NZ; R7:+1==R7; RET C1SPCRCM~ RL1:=','; CHK1C(); RET Z CK1SPCR~ CHK1SP(); RET Z ..."A " / "A\CR\" CHK1CR~ RL1:=0D ...enter wOutset(); Copyin(); Sav() ... .SAV(*) ... Outset(); R4:=R7; Pp(); SETB @R4,5; Sav() ...sym. with small 1st letter ... R2:=RUNSEG; R3:=NCODE; SAVKL(); DEFINE() ... SETTYP(RL0:=ADDRT) ...so can redefine ... LKUPPp(); RL2:=0 ... if R2=RUNSEG and RL0<>0FF they ...performs: if @R3=0, 0->@R13[LINK] else @R3-[R13+LINK-R3]->@R13[LINK] ... [R13+LINK-R3]->@R3 ...returns : R13 unchanged R1:=@R3 R7:=R13+LINK-R3->@R3 if R1<>0 then R1:-R7 R1:->@R13[LINK] RET HASHER~ PROC ...generates hash code for lookup tname RL1:=@R13[LNGTH]; if RL0:=MAXNL0 then begin RL0:='+'->@R7'; Outhex(RL0:=RL2) end R0==R0 end ... POP R3; POP R1 RET ...CHGRR: ...change regs. ... PR XSP,RR2 POPL RR2; R15:+4; R15:->SVQSP ... JP STARTX ... STARTX: ...start execution using GO_PS (must be in ram) PUSH R3; QSEG->W.PSVSEG; R3:=flag; SET R3,15; R3->flag /SEG POP R3 LDRL RR14,XSP WORD 07900 ...LDPS GO_PS: PSVSEG~ WORD 08000 WORD GO_Pith RL3=capital letter, RL1=letter to chk if at 2nd spot ...ret Z=1 if RL3 matches @R7 made capital & @(R7+1)=RL1 (R7:+1) CHK1C~ RH1:=@R7; RESB RH1,5; RL3==RH1; RET NZ R7:+1; RL1==@R7; RET Z; R7:-1; RESFLG Z; RET A0~ := {GETNN / .DO(R3-R3)} .DO(RL0:=RLn OJP() ... else OEXTREF() ... SET TYPE[R13],EXTB; RET LIST~ ...called when bit 6 of DIAGSW is set; enter with R7 pointing to CR Outset(); PUSH R7; R7:=LASTCR; COMM() RL0:=@R7; POP R7 if RL0<>0D then begin ...chk not blank or comm. R5:=EQUVAL ...v...QBUG variables follow: TMPSP~ ADDR STACK+080 ...MYSTAK+040 ...diff. SP used during some debug cmds. NBRKS~ EQU 8 BRKLST~ ;WORD 0FFFF[3*NBRKS] ...[inst @brkpt,brkpt addr];addr offst=FFFF=>empty BRKEXT: WORD 0FFFF ...if<>0FFFF,=addr of routine executed TRRS() ...print regs. ... CHGMRR(B.1) ...change them; fall thru: ... PRTRRS~ RL0:=3 ...print all regs. ... PRTRR~ ...if BIT RL0,0=1, print PC, else not ...if BIT RL0,1=1, print other regs. no matter what, else ... just print those registers diff. frS /NONSEG OJPBK: ...enter with addr in R3 (RETDBG or RETQ) ...put out code to jp to the addr (in Qseg), first setting seg'd ...must be in ram R2:=QSEG LDL RETADR,RR2 OUTN(); WORD 014 WORD 03303 010 ...LDR $+014,R3 (after this code) R3:=flag; SET R3) ; GETADR0~ := .DO(LDL RR2,LstDmp;LDL DOLLAR,RR2) ; D2~ if GETADR0() <> then begin if RL0:=@R7<>0D then RL0==','; RET NZ; LDL RR2,RPC_ end GETCNT~ if CPB @R7,#',' then begin R7:+1; PUSHL RR2; A0(); POPL RR2; RET end RL0:=1; R0==R0; RET NS2~alue of equate in case EQUFLG<>0 if EQUFLG=0 then begin PUSH R7; R5:=LSTNCD ...get addr. beg. of line if Id(R7:=LASTCR) then R5:->LSTLAB POP R7 end HLout(R5); R1:=LSTLAB if EQUFLG=0 and R1<>0FFFF then begin R5:-R1 ...R5=LSat brk ...SBAddr~ WORD 0FFFF 0FFFF ...addr of sp. brk used by SStep ...SBInst~ WORD 0 ...save inst. from above ...SSP~ WORD 0 ...save SP during SStep STBADDR~ WORD 0FFFF 0FFFF ...addr following inst (dynamic) in Step STBINST~ WORD 0 ...save inst. fromom prev.--also store as ... prev. value for next time--[plus print byte @PC] ...preserves all regs. RL6:=RL0 ... RH1:=12 if BITB RL6,0 not zero then begin Outset() OutADR(LDL RR2,RPC_) ...print PC PRTNM() Outlin() ... RH1:=6 end Outset3,15; R3->flag WORD 03103 6 ...LDR R3,$+0A WORD 05E08 ...JP RETADR~ WORD 0 0 ...addr of RETDBG or RETQ goes here RET *ZAPALL TMPS ...*ZAP LABLCMD SLASHST ...*ZAPALL R=^CMD2,^EVBDYLBR ...*ZAP OCSTARI OUTSTARI UPNCD NN2A N2 SVCALC N2ICALC ORGNN CKNDF A0(); if RL0=0 then RL0:+1; ...JR NST2 ...Tr2: A0(); if RL0=0 then RL0:=07F NST2~ RL0:->NXTCNT; R3:=^NGFLG; R0==R0; RET Dump1~ RL0:=1 ... Dump: PROC ...print RL0 lines starting at RR2 LDL DmpAdd,RR2 RL1:=RL0; if RL0=0 then RL1:+1 repeat PUSH R1; TNCD-LSTLAB=disp. if RH5=0 and RL5<>0 then begin OutSP(); Outhex(RL0:=RL5) end end end EQUFLG:=0 MOVTXT() ...put in tab + move text to buffer, truncating if too long if not zero then begin ...Z=1=>no text if R3:=LSTNCD=64; ...tab until col. CdLCol (nominally 64) 08100 0 ...pts. to beg. of last line dumped RRS_~ R0_~ WORD 0 ...regs. stored here R1_~ WORD 0 R2_~ WORD 0 R3_~ WORD 0 R4_~ WORD 0 R5_~ WORD 0 R6_~ WORD 0 R7_~ WORD 0 R8_~ WORD 0 R9_~ WORD 0 R10_~ WORD 0 R11_~ WORD 0 R12_~ WORD 0 R13_~ WORD 0 R14_~ WORDR7 R8 R9 R10R11R12R13R14R15 N4 FC' RRCOPY~ ...enter with R1=reg # (flag=16); R7->output buf. ...if BIT RL6,1=1, print reg. no matter what; else only print if diff. ... from prev.; also copy reg. value to loc. storing prev. value ...save R1,RL6 PUSH R1PACKALL LL ..if BIT E_SEG,15 zero then mark image relocatable by segment OPNIMGFIL() if E_SEG<>0FFFF then PUTHDR() PUTIMG() CLSIMGFIL() RET PUTHDR: ...write out header & segtab to image file ...info @SegDes,SegSegs + E_ADD,E_SEG save R6..R11  just read into buffer RH1:=8 ...count of words repeat Outhex(RL0:=@R3') Outhex(RL0:=@R3') ...print contents of memory OutSP() until RH1:-1 zero; RL0:='|'->@R7' POP R3; RH1:=16 repeat if RL0:=@R3>=07F or RL0<020 then LDB @R7,#'['; R7:+1 repeat R7==^BUFF+LINEL-4; JR UGT,LISTX ...chk if fits in buffer RDaHL(R3); Outhex(RL0:) ...put in ascii of generated code until R3:+1=NCODE; RL0:=']'->@R7' end end else R7:-1 ...back up over tab LI 08100 R15_~ WORD 0 N14_~ WORD 0 ...nonseg R14 RFC_~ WORD 04000 RPC_~ WORD 08100 WORD 0 RRS_0~ ;WORD 0[18] ...prev. value of regs. (thru RFC) stored here NXTCNT~ BYTE 0 ...count of how many NEXT's to do; also=max. depth (by T cmd), NGFLG~ BYTE 0 ... OutSP() R2:=@(R4:=R1*2+^RRS_0) ...Rn_0 R3:=@(R5:=R1*2+^RRS_) ...Rn_ if R3<>R2 or BITB RL6,1 not zero then begin R3->@R4 ...copy reg. value to store prev. PUSH R3 R4:=3; R3:=R1*R4+^RRNMS if R1<10 then R4:-1 LDIRB @R7,@R3,R4 ...move rf not found ... SET TYPE[R13],UNDEFB; RL0==RL0; RET ...ABSCH is set by default ... end ... RET NC ...if found & defined ... GETCHTYP(); RL0==ABSCH; RET Z ... RL0==REL12CH; RET NZ ...error if rel. chain other than 12-bit ... PUSH R7; PUSH R3 ... AL3(@R RL0:='.' RL0:->@R7'; R3:+1 ...put out ascii until RH1:-1 zero; RL0:='|'->@R7' Outlin(); POP R1 until RL1:-1 zero; R0==R0; RET ...OutADR~ ...print addr in RR2 (incl. seg.) ... RL0:=RH2&0F+'0'; if RL0>'9' then RL0:+7 ... RL0:->@R7' ... RL0STX~ Outp(); RET /SEG RETQ~ ...executed upon returning to Q from imm. exec. LDRL RSAV,RR2 LDR R2,QSEG; LDR R3,SVQSP; LDL RR14,RR2 ...res. SP R3:=flag; RES R3,15; R3->flag /NONSEG LDRL RR2,RSAV; RET NOTIMX~ NCDFLG==0; RET ...no ORG or DEFS during im=1 if doing N, 2 if S, 3 if T, 4 if J, 5 if G, else 0 DBUG := .DO(RL3:='Q') ResSVs ST1 := .DO(RL3:='D') {(.DO(RL0==0)) CHGMEM / Dump} := .DO(RL3:='R') PRTRRS := .DO(RL3:='R') (.DO(CALL RW0) / "FC" .DO(RL0:=17)eg name to buff RL0:='='->@R7'; HLout(POP R3) ...value of RR->buffer end else begin RL4:=7 if R1<10 then RL4:-1 if R1>15 then begin RL4:=1; OutSP() end RL0:='.'->@R7' COPYSP(RH1:=RL4) end POP R1; RET COPYSP~ repeat OutSP() until RH1:13[LOVAL]; R7:=NCODE) ...resolve chain ... POP R3; OUTJP() ...put out abs. jp to the label ... R7:->NCODE ... POP R7; R0==R0; RET ...... ...OUTJP~ RESFLG Z; RH0:=flag; PUSH R0; RH1:=8; JP DOJP ... ...8=jp always; flag(Z=0)=not found RESEXTSB: PROC ...:='.'->@R7' ... HLout() ... RET MAXNL~ EQU 10 ...max. no. letters of name to print Name: PROC ...expects an address in RR2 (call $) ...returns: R13=ptr. to symbol of greatest value <=$ in same seg ... (call ^LOC), R1=$-LOC; Z=1 if found PUSHL RR6; LDLm. ex. IMMX0~ ...save ncode if not already; ret R3=NCODE, RL2=NCDFLG R3:=NCODE; RL2:=NCDFLG==0; RET NZ ...fall thru: SAVENCD: R3:=NCODE->SAVNCD; NCDFLG:=1; RET ...ret. R3=NCODE, save other regs RESNCD: ...restore NCODE from SAVNCD if NCDFLG<>0; ret. R / "PC" .DO(RL0:=18) / "N4" .DO(RL0:=16)) .DO(RL1:=RL0*2;RH1:=0;LDA R3,RRS_[R1];R2:=QSEG) CHGMEM := .DO(RL3:='H') NS2 HISTORY := .DO(RL3:='G') .DO(NGFLG:=5) := .DO(RL3:='J') .DO(LDL RPC_,RR2;NGFLG:=4) := .DO(RL-1 zero; RET ...RH1 spaces->@R7+ CHGMEM~ ...change memory: enter with HL->1st mem. spot of 16 PUSHL RR2; Dump1() ...dump 16 bytes of memory CHGMRR() ...make changes; rets. RL1=last input char. POPL RR2; PUSH R1; Dump1() ...display again POP R1; RLreset EXTEND (symbol "EXTEND" @LASTDE..R7) Lkup(R3:=LASTDE); R1:=^EXTADR->@R13[LOVAL] LD TYPE[R13],2**UNDEFB; SETCHTYP(RL0:=ABSCH) LD @R1,#1; R0==R0; RET S_LKUPNL: PROC R5:=1; JR S_LKUP_ ...don't add to symbol table if not found ... S_LKUP: PROC R5: RR6,RR2; R4:=0FFFF->R1 RL0:=0 while Nxtsym(RL0:) zero do begin if R5:=R7-@R13[LOVAL]>=zero and R5<=R1 and RH6=B.@R13[HIVAL] and R3:=@R13[TYPE]&(2**UNDEFB+2**ZAPB) zero and CKABADRT() then begin R5:->R1; R13:->R4 end RL0:=1 end R4:3=NCODE R3:=NCODE; NCDFLG==0; RET Z NCDFLG:=0 R3:=SAVNCD->NCODE; RET IMMXIF~ IMMX0(); PUSHL RR2 CONDIF(); JR IMMX2 IMMX~ IMMX0(); PUSHL RR2 INSTLIST() IMMX2~ if zero then OJPBK(R2:=QSEG; R3:=^RETQ) ...code to ret. via RETQ POPL RR2; R3->NCODE; RL2:3:='B') LSTBRKS := .DO(RL3:='B') GETCNT := .DO(RL3:='X') BRKSOFF := .DO(RL3:='X') ? := .DO(RL3:='L') {GETADR0 / .DO(LDL RR2,LstDmp;R3+1==R3)} .DO(PUSHL RR2) "," .DO(R3:=^BUF 1==0D; RET Z ...if CR, done LDL RR2,DmpAdd; JR CHGMEM ...if LF, repeat with next 16 bytes ...Note: below R4 is used to store current pos. in scr. image CHGMRR~ PUSH R7 R7:=^BUFF; PUSH R7 COPYSP(RH1:=79) ...init. screen image in buffer with spaces  out breakpt. addr. LDL RR4,R3[-2]; LD @R3,#0FFFF R0:=@R3[-4]; LDL RR2,RR4 ...fall thru: ... ResINST~ ...if @RR2 on set bank=0E00, restore inst. in R0, ret. Z=1; else Z=0 CK0E00(); RET NZ; WRR1aRR2(R1:=R0); RET CKBRKPT~ ...enter with RR6=addr to searR15_+4; JR RET2 ... RET_~ R9:+2; TSTCC(RL0:=RL5); RET NZ R3:=R15_ RET2~ R2:=R8 if BIT RFC_,15 not zero then begin ...if seg'd R2:=R14_ RDR1aRR2(); R1:->R8 R3:+2 end RDR1aRR2(); R1:->R9 RET JR_~ R9:+2; TSTCC(RL0:=RH5); RET NZ RL0:=RL5; EXTSin CALL Copy; DEFT 'cc,' end ... RDBCaHL(R3+1); PRTNM2(R1) ... WSend(); RET ...UNASM: ...disassemble R.A insts. @HL ... if RL0=0 then RL0+1 ... PUSH R7 ... repeat PUSH R0 ... R7:=^BUFF; HLout(); PRTNM() ...put out addr.+ name ... PUSH R3; Outbuf(); P 06 08 ...OR,AND,XOR BYTE 018 01A ...MULT,DIV BYTE 026 024 022 ...BIT,SET,RES (have reg. instead of imm. data) LRTAB5I~ EQU $-REGTAB5I TWOTAB~ ...2 word insts (PC->after) distg'd by 1st byte BYTE 0BA 0BB 0B8 03A 03B ...LDI,CPI,etc, IN,OUT port, INIR1:=0 ...B=C=0 SCIPOS(); POP R7 ...set init. pos. in scr. image (->HL), DE=beg. PRTIMG() ...print scr. image from DE to HL while begin Get1(); RL0==0D end <> and RL0<>0A do CHMCHR() ...get char. from keybd until CR or LF & do appropriate thing RLch for in list of breakpts. ...if R7=FFFF, look for empty slot ...Breaklist format: [W.inst,B.seg,B.rpt cnt,W.addr offset] ...if found, R3 at beg. slot R3:=^BRKLST+4; RH1:=NBRKS CKBP1~ repeat RL0:=RH6; SETB RL0,7 if R7=@R3 then begin if R7=0B R0 R9:+(R0:*2); RET DJNZ_~ R9:+2; RL1:=RH5&0F; RH1:=0 if BIT R5,7 zero then begin ...if byte if BIT R1,3 not zero then begin RES R1,3; R1:*2+1 end else R1:*2 RL3:=RRS_[R1]; RH3:=0 end else R3:=RRS_[R1:*2] R3-1; RET Z ...will dec to 0 R1:OP R3 ... Deasm(); POP R0 ...HL is inc'ed past inst. ... until RL0-1 zero; ... POP R7; RET LOCSUB~ ...enter with DEFT 'str' to look for @^BUFF; RR2=addr to start looking ...just look within seg. R2 PUSH R7; R7:=^BUFF; R6:=QSEG; LOCSTR(R1:=0) if zero,etc BYTE 030 031 032 033 034 035 037 ...LD (BA), LDA (BA), LDR,LDAR BYTE 070 071 072 073 074 075 077 ...LD (BX), LDA (BX) L2TAB~ EQU $-TWOTAB FNDNXTPC~ ...get next PC after RPC_->RR2 LDL RR8,RPC_; FNPC2() ... Outset(); HLout(R8); HLout(R9); Outlin()0:->RL1 ...ret. RL1=last char. gotten Put1(RL0:=0D); POP R7; RET CHMCHR~ ...chk char. in RL0 & do approp. thing RL0:->RL7 if RL0=8 then begin RL0:=RH1|RL1; RET Z ...if backspace & not 1st pos. if RL1=0 then begin RH1:-1; RL1:=4 end RL1:-1 FFFF or RL0=@R3[-2] then begin R3:-4==R3; RET end end R3:+6 until RH1:-1; ...not found R3:-10; RET ...Z=0 MBPERL~ EQU 3 ...max. no. of brkpts. to be listed per line LSTBRKS~ ...list addresses of all breakpts. + disp. from last label Outset() =R5&07F==1; RET Z ...sp. case for DJNZ $ R9:=R9-(R1:*2); RET ...note: for now, CALL_ & CALR_ must save R7 CALL_~ PUSHL RR8; CNTREG(); POPL RR2; JR CALJP2 ... JP_~ PUSHL RR8; CNTREG(); POPL RR2 TSTCC(RL0:=RL5); RET NZ CALJP2~ if RL0:=RH5&0C0 zero then b then Dump1() POP R7; R0==R0; RET LOCSTR~ ...search for string: RR2->text, RR6->DEFT 'str', R1 count ...returns: RR2 at beginning of string in memory, Z=1 if found R0:=flag; SET R0,15; R0:->flag /SEG JR CPS0 CPSLUP~ POP R3; POP R7; POP R1 if R1=0 the LDL RR2,RR8; RET FNPC2~ RDR1aRR2(LDL RR2,RR8); R1:->R5 ...keep 1st word of inst in R5 if RH5=09E then begin RET_(); RET end if RH5=07F then begin SC_(); RET end if RL0:=RH5&0F0=0C0 then begin R9:+2; RET end ...LDB if RL0=0D0 then begin CALR_(); RE SCIPOS() ...R3=new screen image pos., R7=old one repeat Put1(RL0:=8); R7:-1 until R3=R7; RET end RH1==8; RET Z ...if at end of row RL0==' '; JR Z,MVCRS1 if RL0=9 then begin repeat MVCRS() until RL1=0; RET end HexdA(); RET NZ ...chk if he R3:=^BRKLST+4; RH1:=NBRKS; RL1:=MBPERL+1 repeat if R0:=@R3<>0FFFF then begin if RL1:-1 zero then begin RL1:=MBPERL PUSH R3; Outlin(); POP R3; Outset() end ...if after MBPERLth brkpt., start another line PUSH R3; PUSH R1 egin ...IR mode RL1:=RL5/16*2; RH1:=0 R9:=RRS_[R1] BIT RFC_,15; RET Z RES R1,1; LDL RR8,RRS_[R1] RET end ...get addr: RDR1aRR2(R3+2); R1:->R9 if BIT RFC_,15 not zero then begin ...if seg'd if BIT R1,15 zero then begin ...short offsn RESFLG Z else begin CPS0~ LDB RL0,RR6[1]; CPIRB RL0,@RR2,R1,Z ...chk 1st char. if zero then begin if RL0:=@RR6-1<>zero then begin ...@R7=length PUSH R1; PUSH R7; PUSH R3; RL1:=RL0; RH1:=0; R7:+2 CPSIRB @RR6,@RR2,R1,NZ; JR Z,CPST end if RL0=0E0 then begin JR_(); RET end if RL0=0F0 then begin DJNZ_(); RET end ...chk for 1 word insts distinguished by 1st byte: R3:=^ONETAB; R1:=L1TAB; CPIRB RH5,@R3,R1,EQ if zero then begin R9:+2; RET end if R0:=R5&0FF0F=07B00 then begin IRET_(x digit RL0:->@R4; PUSH R1 ...store in scr. image ASCtoN() ...RL0=value of char. RL7:=RL1/2+(RH0:=RH1*2); RH7:=0 ...DE=2*B+(C/2) LDL RR2,LstDmp ...^memory region to be changed R3:+R7 ...pt. to memory byte to be changed ...RL0=value to replace in OutADR(LDL RR2,R3[-2]) ...put out addr DNAM() ...put out last label+disp. COPYSP(RH1:=2) POP R1; POP R3 end R3:+6 until RH1:-1 zero; Outlin(); RET ...the following is for FNDNXTPC: ONETAB~ ...1st byte of 1 word insts (PC->aftet RH1:->RH0; SETB RH0,7; RL0:=0; RH1:=0 LDL RR8,RR0 end else begin R1:->R8 RDR1aRR2(R3:+2); R1:->R9 end end RL1:=RL5/16; RET Z ...DA (/16=SRL) RL1:*2; RH1:=0 R9:+RRS_[R1]; RET ...X CALR_~ R1:=R5&0FFF if BIT R1,11 not zerLUP ...rem. chars. CPL RR2,RR6; JR Z,CPSLUP ...don't catch test string POP R3; POP R7; POP R1 end R3:-1==R3 end end R0:=flag; RES R0,15; R0:->flag /NONSEG RET HISTORY~ PROC ...print addr.+last label(+disp) of last R.A entr); RET end ...chk for 1 word insts distg'd also by low nibble: R3:=^ONETABN; R1:=L1TABN; CPIR R0,@R3,R1,EQ if zero then begin R9:+2; RET end ...chk for regular type distg'd by 6 bits in 1st byte: RH0:=RH5&03F if RH0=01E then begin JP_(); RET end if  nibble if BITB RL1,0 zero then begin RL0:*16; RL7:=0F ...replacing high nibble end else RL7:=0F0 ...replacing low nibble RL0:->RH7 RDaRR2(); RL0:&RL7+RH7 WRaRR2(RL0:) ...replace byte POP R1 ...fall thru: ... MVCRS~ ...move cursor along under er) distinguished by 1st byte BYTE 03C 03D 03E 03F ...IN,OUT @R BYTE 07A 07C 07D ...HALT,EI,DI,LDCTL BYTE 0AE 0AF ...TCC BYTE 0B0 0B1 0B4 0B5 0B6 0B7 0BC 0BD 0BE ...DA,EXTS,ADC,SBC,RRD,LDK,RLD L1TAB~ EQU $-ONETAB ONETABN~ ...1 word insts distg'd alo then R1:|0F000 R9:=R9+2-(R1:*2); RET LDPS_~ CALL_() ...RR8=addr of status LDL RR2,RR8; R3:+2 if BIT RFC_,15 not zero then begin ...if seg'd RDR1aRR2(R3:+2); R1:->R8 R3:+2 end RDR1aRR2(); R1:->R9 RET SC_~ R1:=flag; SET R1,15; R1:->flag /SEies at R_SP LDL RR2,R14_ repeat PUSH R0; PUSHL RR2; RDR1aRR2() Dump1(R2:=RPC_; R1); POPL RR2; POP R0 R3:+2 until RL0:-1 zero; RET BRK~ PROC ...expects RR2 pointing to brk address; RL0=repeat count ...ret. Z=0 if brks used up or in rom, else Z=1RH0=01F then begin CALL_(); RET end R3:=^REGTAB6; R1:=LRTAB6; CPIRB RH0,@R3,R1,EQ if zero then begin if RH0=039 then begin LDPS_(); RET end if RH0=01C and BIT R5,0 not zero then R9:+2 ...LDM: 1 word extra CNTREG(); RET end RESB RH0,0 ...chk  memory dump MVCRS1~ if RL1:+1=4 then begin RH1:+1; RL1:=0 end SCIPOS() ...R3=new screen image pos., R7=old one PRTIMG~ R3==R7; RET Z Put1(RL0:=@R7'); JR PRTIMG ...update scr. from scr. image CHMTAB~ BYTE 21 26 31 36 41 46 51 56 60 ...ditto CHGMEM Bso by low nibble (except rotates) WORD 08C01 08C09 08D01 08D03 08D05 08D07 ...LDCTLB,SETFLG,RESF,COMF,NOP WORD 07B08 07B09 07B0A 07B0D ...MSET,MRES,etc L1TABN~ EQU $-ONETABN ...regular type insts: ... mode 10/00=1 word, 01=2 words nonseg or short offseG WORD 07D24 07D35 ...LDCTL RR2,PSAP LDL RR8,RR2[01C] RES R1,15; R1:->flag /NONSEG RET CNTREG~ ...count # words in regular-type inst, update R9; save R5 R9:+2 RL0:=RH5&0C0; RET Z ...0=IR mode RL0==080; RET Z ...R mode ...left is DA/X LDL RR2,R PUSH R7; PUSH R0; LDL RR6,RR2; PUSHL RR6 if CKBRKPT() not then begin ...chk if not already brkpt. PUSH R7; CKBRKPT(R7:=0FFFF) ...if not, look for empty slot POP R7; JR NZ,NOBRK ...err if no empty slot R3<->R7; RDR1aRR2(); R1:->@R7 ...copy bfor regular type distg'd by 5 bits in 1st byte: R3:=^REGTAB5; R1:=LRTAB5; CPIRB RH0,@R3,R1,EQ if zero then begin PUSH R0; CNTREG(); POP R0 if RH0=0C and BIT R5,0 not zero then R9:+2 ...sp. imm: add 1 word RET end ...chk for regular type distgYTE 0 ...filler SCIPOS~ ...using B & C, get R3,R4=current pos. in screen image; set R7=old one R3:=^CHMTAB RL7:=RH1; RH7:=0; R3:+R7; RL7:=@R3 ...E=tab corres. to B R3:=^BUFF+R7; RL7:=RL1; R3:+R7 R7:=R4; R3->R4; RET DEASM~ PROC ...disassemble @RPC_t else 3 words ... (add 1 or 2 more words for imm. data) ... note: ONETAB,ONETABN should be checked before these unless missing mode ... cases are specially checked REGTAB6~ ...regular type insts distg'd by 6 bits in 1st byte ... add 1 word for sp. imm. R8 R9:+2; BIT RFC_,15; RET Z ...nonseg. RDR1aRR2(); BIT R1,15; RET Z ...short offset R9:+2; RET TSTCC~ ...ret. Z=1 iff CC in RL0 low nibble matches RFC_ (must be done in ram) RL0:&0F->B.TSTCCC; RH0:=0 R1:=RFC_; RL1:->flag BYTE 0AE ...TCCB TSTCCC~kpt word if PutBrkW() not zero then begin ...set bkpt NOBRK~ POPL RR2; POP R0; POP R7; RET ...ret. Z=0 if rom end R3<->R7; R3:+2; SET R6,15; LDL @R3,RR6 ...save brk address end CKBRKPT(POPL RR6); POP R0; RL0:->@(R3+3) ...store repeat cou'd by 6 bits in 1st byte; ... add 2 words for imm. data if mode=00 & 3rd nibble=0: RH0:=RH5&03F R3:=^REGTAB6I; R1:=LRTAB6I; CPIRB RH0,@R3,R1,EQ if zero then begin CNTREG() if R5&0C0F0 zero then R9:+4 RET end ...chk for regular type distg'd b ...for now, dump 4 words or "CALL NN" if begin PUSH R7; Call(); POP R7 end then begin ...Call sets RR2=RPC_, R5=inst DEASMC~ LDL RR8,RR2 if RL0:=RH5&0F0=070 then begin ...SC Copy(); DEFT 'SC '; Outhex(RL0:=RL5) end else begin if RLdata cases BYTE 013 011 017 015 ...PUSH (ex. imm.),POP BYTE 01D 039 ...LDL (->mem),LDPS (not mode 10) BYTE 01C ...TESTL/LDM BYTE 036 ...LDA (not mode 10/00) LRTAB6~ EQU $-REGTAB6 REGTAB5~ ...regular type insts distg'd by 5 bits in 1st byte BYTE 0 BYTE 0 RH0:-1; RET Step~ PROC ...execute next instruction using stored regs.; store new regs. LDL RR2,RPC_; LDL R_PC0,RR2 ...save PC if CKBRKPT(LDL RR6,RR2) zero then begin ResINST(R0:=@R3; LDL RR2,RR6) ...if at brkpt., restore inst. if not znt POP R7; R0==R0; RET PutBrkW~ ...put out break word @RR2, ret. Z=0 if rom WRR1aRR2(R1:=0E00) CK0E00~ RDR1aRR2(); R1==0E00; RET ...ret. word @RR2 in R1 BRKSOFF~ ...remove all breakpts. R3:=^BRKLST-2; RH1:=NBRKS repeat R3+6 until R0:=@R3<>0FFFF or Ry 5 bits in 1st byte; ... add 1 word for imm. data if mode=00 & 3rd nibble=0: R3:=^REGTAB5I; R1:=LRTAB5I; RESB RH0,0; CPIRB RH0,@R3,R1,EQ if zero then begin CNTREG() if R5&0C0F0 zero then R9:+2 RET end ...chk for 2 word insts distg'd by 1st b0=0D0 then CALR_() else CALL_() Copy(); DEFT 'CALL ' PRTNM2(LDL RR2,RR8) if not zero then OutADR(LDL RR2,RR8) end RET end RL4:=4 repeat PUSHL RR2; RDR1aRR2(); HLout(R3:=R1); OutSP() POPL RR2; R3:+2 until RL4:-1; RET ... ...if f2E ...LD (->mem) (not mode 10) BYTE 02C 028 02A ...EX,INC,DEC ...the following distinguish bet. themselves by low nibble: BYTE 0C ...COM,NEG,TEST,TSET,CLR; CP,LD,PUSH (sp. imm., not mode 10) LRTAB5~ EQU $-REGTAB5 REGTAB6I~ ...reg. type distg'd by 6 ero then BRKOFF() ...if no 0E00 (possible if overlays) end FNDNXTPC() ...get PC after current inst.->RR2 RDR1aRR2(); R1:->STBINST ...store following inst. PutBrkW(); JR NZ,STRET2 ...put out 0E00; Z=0 =>rom LDL STBADDR,RR2; R15:->STSP ...set brkptH1:-1 zero; RH1==0; RET Z REMBRK() JR BRKSOFF BRKOFF~ ...remove breakpt. at R.HL PUSH R7; CKBRKPT(LDL RR6,RR2); POP R7; RET NZ ...ret. if not found R3:+4 REMBRK~ ...enter: @R3=breakpt. addr. offset, @R3[-4]=inst. from breakpt. ...restore inst. & FFyte: RH0:=RH5; RESB RH0,0 R3:=^TWOTAB; R1:=L2TAB; CPIRB RH5,@R3,R1,EQ if zero then begin R9:+4; RET end RH0:=RH5; RESB RH0,0 if RH0=0B2 then begin R9:+2 ...rotates=1 word if BIT R5,0 not zero then R9:+2 ...shifts=2 words end RET IRET_~ R3:=ull Deasm not patched in, just chk for Call ... B.Deasm==05E; R_PC; JP Z,Deasm ... Call(); RET NZ ...if Call, print CALL ?"cc,"SUBR (Call sets HL=R_PC) ... WSbgn() ... CALL Copy; DEFT ' CALL '; BYTE 0 ...doesn't clobber R.A or HL ... if RL0<>0CD then begbits where 3rd nibble=0 =>imm. data BYTE 014 016 012 010 ...LDL,ADDL,SUBL,CPL BYTE 018 01A ...MULTL,DIVL LRTAB6I~ EQU $-REGTAB6I REGTAB5I~ ...reg. type distg'd by 5 bits where 3rd nibble=0 =>imm. data BYTE 020 0 02 0A ...LD (->R),ADD,SUB,CP BYTE 04  on next inst; save SP JP Go2 ...execute the inst. STRET~ ...ret. here after Step R15:=STSP RESSTBRK() ...res. inst @brkpt STRET2~ LDL RR6,R_PC0 if CKBRKPT() then WRR1aRR2(LDL RR2,RR6; R1:=0E00) ...if were at breakpt., restore '0E00' RET ...Res R1:=^NAME; R3+R1->R3 ... RL1:=@R13[LNGTH]; LDIRB @R7,@R3,R1; WSend() ...print subr. name ... end ... end ... else SStep2() ... end ... end ... else Step() ... R7:=R_SP; POP R3 ...HL=orig. R_SP ... until R30 then RESB RL0,0; RET RW0 := .DO(RH1:='W') CKRTYP ; RB0 := .DO(RH1:='B') CKRTYP ; RRL0 := .DO(RH1:='L') CKRTYP ; RQD0 := .DO(RH1:='Q') CKRTYP ; CKRTYP: RL0==RH1; RL0:=RL1; RET Z; JR RXF NOTR: n any seg.) PUSHL RR2 LD R3,RR14[6]; LDR RFC_,R3 ...get & store FCW LDL RR2,RR14[8]; LDRL RPC_,RR2 ...get & store PC LDCTL R3,NSPSEG; LDR N14_,R3 ...nonseg R14 POPL RR2 R15:+8; LDRL R14_,RR14 ...save adjusted RR14 LDRL R12_,RR12; LDR R12,QSEG; R...no instlist CKEND() ...chk nothing else on line OJPBK(^RETDBG) ...put out code to jp to RETDBG ResSVs() ...reset NCODE, NCDFLG, DBGFLG R0:=^GOXX ...GOXX goes to XAdd in currently-set seg. end stk->flag; LDM R1,@R15,14; R15:+28; R0:<->@SBrks~ ResSBrk() ...reset sp. SStep brk ... RESSTBRK~ ...reset Step break LDL RR2,STBADDR; R3==0FFFF; RET Z ResINST(R0:=STBINST); LD STBADDR+2,#0FFFF; RET CkInst0~ ...ret. inst. @RPC_ in R5; also set RR2=RPC_ CK0E00(LDL RR2,RPC_); R1:->R5; RET NZ ..G~ PROC ...case NGFLG of 1:Next; 2:Skip; 3:Trace; 4:Jump; 5:Go end R15:=^TMPSP ...temp. stack in lower region of mystak RL0:=NGFLG==3; JR Z,Trace JP C,Next ...Next needs NGFLG in RL0 if RL0:-5 zero then begin ...Z=1 if "G", Z=0 if "J" Go~ ...contREG(); JR Z,RXF; R0==R0; RET RQ: ...test for quad reg. RQD0(); RET NZ; JR RXSV RRNZ: RRL0(); RET NZ; RL0==0; JR NZ,RXSV; JR RXF ...do RRL except RR0 fails RRL: ...test for double reg. & save code RRL0(); RET NZ; JR RXSV RB: ...test for byte reg. & save13:=^RRS_ LDM @RR12,R0,12 ...store rest of regs. in variables LDR R2,QSEG; R3:=R14; SET R3,15; RL3:=0 if R3<>R2 or R15<=(^MYSTAK+030) or R15>^MYSP then begin R3:=^MYSP; LDL RR14,RR2 ...set SP (leave if in Q's stk) end R3:=flag; RES R3,15; R3->flaR15; RET *ZAPALL TMPS ...*ZAP TMPSP NBRKS ...*ZAPALL R=^BRKLST,^CKEND ...*ZAP L1TAB L1TABN LRTAB6 LRTAB5 LRTAB6I LRTAB5I L2TAB ...*ZAP DBUG3 *PACKALL STBADDR~ WORD 0FFFF 0FFFF ...addr following inst (dynamic) in Step STBINST~ WORD 0 ...save inst. from.chk if brk word (0E00) CKBRKPT(LDL RR6,RR2); R3<->R7; RET NZ R5:=@R7; RET ...if set brk, get orig. inst. Call~ PROC ...tests for a call instruction @RPC_; Z=1 iff true ...ret. RR2=RPC_, R5=inst CkInst0() ...inst->R5 RL0:=RH5&0F0==0D0; RET Z RL0:=inue execution: if at brkpt, do Step first (restores brkpt) if CKBRKPT(LDL RR6,RPC_) zero then Step() end Go2~ LDL RR2,RPC_; LDL GO_PSPC,RR2 RFC_->GO_PSFC ...load prog. status vector LDL RR2,R14_; LDL XSP,RR2 ...RR14 must be loaded in seg. mode LD code (also->R.A) RB0(); RET NZ JR RXSV ...save R.A as hex RW07: RW0(); RET NZ; RL0==8; JR C,RXSV; JR RXF ...do RW except >R7 fails PKRNZ: SEGMD==0; JR NZ,RRNZ ...do RRNZ or RNZ according to mode RWNZ: RW0(); RET NZ; RL0==0; JR NZ,RXSV; JR RXF ...do g ...04000->flag /NONSEG LDL RR6,RPC_ CPL RR6,STBADDR; JP Z,STRET ...chk if was Step brk ... CPL RR6,SBAddr; JP Z,SBRET ...chk if was spec. brk (used by SStep) R3:=BRKEXT if BIT R3,0 zero then begin CALL @R3; JR CONTX end ...chk if to execute pf zero then SET TYPE[R13],ZAPB ...mark zapped R0==R0; RET CKNOTDOT: CPB @R7,#'.'; COMFLG Z; RET Z NOGD_~ NOGD~ RESFLG Z ...back up over id, set Z=0 R7:=LASTDE; RET ... IdCOL~ Id(); RET NZ; CPB @R7,#':'; JR NZ,NOGD ...chk for id followed by ':' CKDEFRH5&03F==01F; RET Z RH5==07F; RET ...Pop: PROC ...check for POP -- or EX (SP),-- inst. @R_PC ... CkInst0() ...get inst.->R.A, R_PC->HL ... RL0==0C1; RET C ... if RL0=0FD or RL0=0DD then RDaHL(R3+1) ... RL0==0E3; RET Z; RL0&0F-1; RET StepSP~ ...do StepM R0,RRS_,14 ...regs. back JP STARTX ...starts execution /SEG RETDBG~ ...go to Debug, setting nonseg. & saving all regs. & flag ...also set SP if not in Q's stack LDRL RSAV,RR2; LDR RSAV+4,R4 R4:=flag R3:=R14; SET R3,15; RL3:=0; LDR R2,QSEG if R3<RW except R0 fails ... PKR: SEGMD==0; JR NZ,RRL ...do RW or RRL acc. to mode RW: ...test for word reg. & save code (also->R.A) RW0(); RET NZ ...chk syntax RXSV: PUSH R0; SavB(); POP R0; RET ...save RL0 as hex RXF: RESFLG Z; R7:=LASTDE; RET ...fail RNrocedure & then cont. CKBRKPT(); RH0:=flag; PUSH R0 if zero then begin ...Z=1 indicates was set brkpt. if RL0:=@(R3:+3)<>0 then DECB @R3 ...dec. repeat count if RL0:=@R3<>0 then begin CONTX~ R15:=^TMPSP; JP Go ...do Go if repeat count>0 e(); RET NZ R7:+1; R0==R0; RET ...ret RR2=value ... CKDEF0~ LKID(); JR C,NOGD; JR NZ,NOGD; RET CKDEF~ CKDEF0(); RET NZ ...chk if last id is defined CKDEF2~ GETVAL() ...value->RR2 MRKREF() ...mark referenced R0==R0; RET ... CKDEFCON~ ...chk for def'd, then compare RR14_ to RR6=orig. RR14_, preserving RR6 ... ret. Z=1 iff RR14_>=RR6 PUSHL RR6; Step(); POPL RR6 LDL RR2,R14_ if BIT RFC_,15 not zero then begin R2==R6; RET NZ ...if seg'd, must be same seg. end if R3>R7 then begin R7==0; COMFLG Z >R2 or R15<=(^MYSTAK+030) or R15>^MYSP then begin ...set SP R3:=^MYSP; LDL RR14,RR2 end RES R4,15; R4:->flag ...set nonseg'd & restore flag byte /NONSEG LD R4,RSAV+4; LDL RR2,RSAV JP Debug GOXX~ R3->RSAV; R3:=flag; LD RSAV+2,R3 R3:=R14_; RL3:=0;00: R7:+1; RL1:-1 RN0: RL1:-1 ...RN: ...chk digits of Rn; enter with R.C=no. of digits, DE at 1st ...return R.A=value of digits; if fail, DE=LASTDE RL0:=@R7-'0'; JR C,RXF RL0==10; JR NC,RXF; R7:+1 RL1:-1; RET Z ...ret. if only 1 digit RL0:-1; JR NZ,Rnd R1:=@(R3:-3); WRR1aRR2(LDL RR2,RR6) ...restore inst. for Dump end LDL RR2,RR6; PUSHL RR2 Dump1() ...display memory if Call() then begin ...rets. RR2=RPC_ Outset(); RL0:=9->@R7'; RL0:->@R7'; DEASMC(); Outlin() ...disassemble end PRTRR(RL0: & EQUT,ADDRT,LABLT, or ARRAYT else backup CKDEF0(); RET NZ GETTYP(); RL0==EQUT; JR Z,CKNOTBP; RL0==LABLT; JR Z,CKNOTBP RL0==ADDRT; JR Z,CKNOTBP; RL0==WARRAYT; JR Z,CKNOTBP RL0==BARRAYT; JR NZ,NOGD ... CKNOTBP~ ...chk not followed by "[" / "(" if RL0:end RET SStep~ PROC ...steps over subroutines ...specifically if Call skips until RR14_>=old Stack Pointer if Call() not zero then begin ...chk if at CALL Step(); RET end LDL RR6,R14_ repeat StepSP() until zero; ...do Steps until RR14_>=orig. R  SET R3,15 if R3=QSEG and R3:=R15_>^DBGSTK+030 and R3<=^DBGSP then R15:=R3 else R15:=^DBGSP PUSH XAdd; PUSH NCDSEG LD R3,RSAV+2; R3->flag; R3:=RSAV JP GOX ResSVs~ DBGFLG:=0 RESNCD(); RET ...RESNCD~ NCDFLG==0; RET Z ... NCDFLG:=0 ...RETNCD~ W.SAVNXF ...chk 1st digit=1 RL0:=@R7-'0'; JR C,RXF; RL0==6; JR NC,RXF; R7:+1; RL0:+10 R0==R0; RET REG: ...test for a reg. of any type, incl. REGT syms.; type->RL0, value->RL1 ...if true, ret. RH0=0 iff not REGT sym. if RTYPFLG=0 then begin CPB @R7,'R'; =2) ...print regs. POPL RR2 POP R0; RH0:->flag; if zero then PutBrkW() ...restore '0E00' RESNCD() ...res. NCODE if offset R0:=RFC_; RL0:->flag; LDM R0,RRS_,14 ...restore regs. JP Debug Next~ ...if RL0=1, do NXTCNT insts.; if =2, same but skip pro=@R7<>'[' then RL0=='(' endif; JR NZ,CKDEF2; JR NOGD ... CKDEFAB~ CKDEF0(); RET NZ ...chk for defined & adr (not based, equ, or reg.) CKABADRT(); JR NZ,NOGD; JR CKDEF2 ... GETTYP(); RL0==BASBYTT; JR Z,NOGD; RL0==BASWRDT; JR Z,NOGD ... RL0==REGT; JR Z,NOGR14_ RET ...note: if subr. pops stack & changes ret. addr., must do POP or ... EX (SP), within 4 insts. or goofs up ... if Call() not zero then begin ...chk if at CALL ... Step(); RET ... end ... ...note: DE=R_SP, HL=R_PC set in Call ... R3+3->SAVADCD->W.NCODE; RET ...ret. R3=NCODE ...OFFNCD~ NCODE->SAVNCD; NCDFLG:=1; R3:+040->NCODE; RET ...ret R3=offset NCODE OFFNCD~ SAVENCD(); R3:+040->NCODE; RET ...ret R3=offset NCODE CKEND~ COMM(); CPB @R7,#0D; RET Z; Err() ...BKDBG: NORMSG(R14_)->R2; R3:=RRET NZ IdLN(); RET NZ; REG2(); RH0:=0; RET end IdLN(); RET NZ R3->R6 ...end of id (R7,LASTDE at beg, RL0=len) if CPB @R7,'R' then begin REG2(); RH0:=0; RET Z end R7:=R6 LKIDTYP(); RL0==REGT; JR NZ,RXF GETVAL(); RL0:=RH3; RL1:=RL3; RH0:=1; RET ..c. calls repeat PUSH R0 if RL0:-1 zero then Step() else SStep() Outset() OutADR(LDL RR2,RPC_); DNAM() ...print PC+disp from nearest symbol DEASM() ...disassemble Outlin() PRTRR(RL0:=0) ...display regs. that change POP R0 until DECD; JR CKDEF2 ... CKADDR~ CKDEF0(); RET NZ ...chk ADDR type / backup GETTYP(); RL0==ADDRT; JR NZ,NOGD; JR CKDEF2 LKIDTYP: ...look up last id & get type->RL0 (0FF if undefined) ...mark ref'd if defined LKID() GETLKTYP~ RL0:=0FF if zero and not carry thR ...save ret. addr. for special break if used ... StepSP(); RET NC ...do Step, chk if R_SP(^TMPSP+030) and R3<=^MYSP then R15:=R3 ... else begin ...DBUG1: R15:=^MYSP ... end ... Debug0: R15:=^MYSP Debug: R0:->stk; R15:-28; LDM @R15,R1,14; flag->stk DBUG2: R15:->SAVSP; DBGFLG:=1 ...if DBGFLG<>0, ret. here after Err . REG2: ...test for a regular reg. of any type; type->RL0, value->RL1 ...enter here with RL0=id length, R7 at beg. RL0==4; RET UGT RL0:->RL1; R7:+1 if RL0:=@R7='L' then begin RN00(); RET NZ; RL0==8; JR NC,RXF; RL0:+8; JR REGBX end if RL0='H' then B NXTCNT zero; ...dec. count JP Debug0 Trace~ ...traces a routine, printing out names of all subroutines it executes ... indenting to depth of stack, up to a stack depth of NXTCNT words ... R_SP->R3 ... repeat PUSH R3 ...save orig. R_SP ... if Call(en begin GETTYP(); MRKREF() end RL0==RL0; RET LKID~ ...look up Id in symbol table without linking in (get flag) Lkupnl(W.LASTDE); RET LKUPRe: ...Re & look up symbol; ret. R3=value PUSH R7; Outset(); PUSH R7; Re(); Lkupnl(POP R3); GETVAL() POP R7; RETR Z,SStep3 ...chk for POP or EX (SP).. etc. ... PUSH R1; StepSP(); POP R1 ...do Step & comp. R_SP to orig. ... RET NC ...if R_SP>=orig. R_SP ... until RH1:-1 zero; ... W.SAVADR; B.RDaHL()->SBInst ...store inst from @(ret. addr.) ... if PutBrkW() ze... ResSBrks() RESSTBRK() ...reset sp. brk used by Step just in case missed Getcon(RL0:=DPRMPT) NGFLG:=0 if CPB @R7,#'/' then begin R7:+1 if CMD1() zero then begin CKEND(); JR DBUG2 end ...if cmd, don't offset NCODE OFFNCD(); JR DBUG3 ...if /begin RN00(); RET NZ; RL0==8; JR NC,RXF REGBX: RL0:->RL1; RL0:='B'; RL0==RL0; RET end if RL0='R' then begin RN00(); RET NZ; BITB RL0,0; JR NZ,RXF; RL0:->RL1; RL0:='L'; RET end if RL0='Q' then begin RN00(); RET NZ; RL0:->RL1&3; JR NZ,RXF; RL0) then begin ...Call sets DE=R_SP ... R3+3->SAVADR ...needed by SStep2 ... if StepSP()R3 ...get diff. in stack level ... ...Z8000 stuff: *ZAP Test Del Icopy Copyin Copy Outset Out OutN Sav SavB Gen Zp Err0 *ZAP Re Xc WRe0 WRe4 WRe8 OUTRe ...the following (to -----) is not zapped after assembly language section ... except some individually: ...SVSEGAD := .SAV("H"HLout","Re)ro then begin ...put out 0E00; Z=0 =>rom ... R3->SBAddr; R15:->SSP ...set special brk; save SP ... JP Go ...go ... end ...SStep3: repeat StepSP() until >=zero; ...do Steps until R_SP>=orig. R_SP ... RET ...SBRET~ ...come here after sp. brkpt (usedinstlist, offset NCODE (->R3) end PUSH NCODE OFFNCD() ...NCODE->SAVNCD; NCODE+040->NCODE if begin DBUG(); POP R3 end then begin ...DBUG cmds use offset NCODE CKEND() ...chk nothing else on line ResSVs() ...reset NCODE, NCDFLG, DBGFLG NGFLG:='Q'; RET end RL1==3; JR UGT,RXF RN0(); RET NZ; RL0:->RL1; RL0:='W'; RET ...------ OW_8084_R := .OUT("W"WRe8 WRe0 WRe8 WRe4) OUTRe ; OO_40 := .OUT("O"ORe4 Re) ; OO_04 := .OUT("O"Re ORe4) ; SAVR := .DO(PUSH R0) ReK .SAV("R" .DO(POP R0;RL0:->@R7') HLou if NXTCNT*2>=RL3 then begin RL7:=RL3 ... if Name(R_PC) and RH1|RL1 zero then begin ...if symbol at R_PC ... RH1:=RL7 ...diff. in stk level ... WSbgn(); COPYSP() ...put out R.B spaces ... R3->R13 ...HL pts. to entry in symbol table ...  ; OW_408 := .OUT("W"WRe4 WRe0 WRe8) ; OW8_048 := .OUT("W8000"WRe0 WRe4 WRe8) ; OWBD_04 := .OUT("WBD00"WRe0 WRe4) ; W884 := WRe8 WRe8 WRe4 ; DJNZ3 := .DO(PUSH R0) .OUT("OF0"Xc Re) .DO(POP R0) SAVR OUTRe ; PKSP := .DO(RWTORR(RL0:=15)) SavB ; RWTORR: ...if  by SStep) hit ... R15:=SSP ... ...ResSBrk~ ...reset special break used by SStep ... LDL RR2,SBAddr; R3==0FFFF; RET Z ... ResINST(R1:=SBInst); LD SBAddr+2,#0FFFF; RET /SEG B_RTN: ...control goes here after break (PC,FCW on stk) ...(written so can run o==0; JR Z,DBUG2 ...if NGFLG<>0, means N,S,T,J or G cmd R0:=^NSTJG ...where to go end else begin R3:->NCODE ...=SAVNCD ... RETNCD() ...SAVNCD->NCODE->R3 DBUG3~ R3->XAdd; CALL INSTLIST if not zero then begin CKEND(); ResSVs(); JR DBUG2 end  t) ; TYPL := .DO(INSTTYP=='L') ; SAVAWB := .DO(if INSTTYP='W' then RL0:+1) SavB ; SAVAFIXL := .DO(if INSTTYP='L' then RL0:+4) SavB ; BL_DEL := .DO(if RL0:=@R7='B' or RL0='L' then R7:+1) Del .DO(RL0:=INSTTYP) ; DATA := {"#"} .DO(NOTR();RET NZ) ; DAT := .OUT("W4000"WRe0 Xc WRe4 Xc WRe8) OUTRe ; PUSHL_ := .SAV(11) {CMA / PKSP OW_408} := PKSP PUSHL2 ; PUSHL2 := OW8_048 / PUSH2 ; UNOP : BL_DEL() RL0=='B'; JP Z,UNOPB; RL0=='L'; JP Z,UNOPL ...fall thru: UNOPW := .SAV(0D) if RH0='B' then RL0:-1 RH0:->INSTTYP RL0==2; JP Z,INST2B; RL0==3; JP Z,INST3B; RL0==4; JP Z,INST4B RL0==5; JP Z,INST5B; RET PIKINSTC: if RH0='B' or RH0='L' then RL0:-1 RH0:->INSTTYP RL0==2; JP Z,INST2C; RL0==3; JP Z,INST3C; RL0==4; JP Z,INST4C OW_8084_R := := .OUT("H1D") OO_04 := .OUT("H5D") OO_04 OUTRe ; LDRL2 := .SAV(5) OW3_884X0_R := .SAV(14) EXC ; LDA2 := .SAV(4) OW3_884X0_R := .SAV(36) EXC EXOP2A ; AROP : / .DO(SAVNN(0FFFF))} OUTRe ; SHIFTD : BL_DEL(); RL0=='B'; JP Z,SDB; RL0=='L'; JP Z,SDL ...fall thru: SDW := ; SD2 := OO_40 .OUT("H"WRe8) ; SDL := ; SDB := ; SHFW1 := .OUT("HB3") ; SHFB1 := .OUA0 := {"#"} .DO(NOTR();RET NZ) ; DATA1CK := (.DO(RH3==0;RL0:=RL3)) ; DATA1B := SAVN ; DATA1D := .DO(RH3:=RL3) SAVNN ; DATA1_16 := (.DO(RL3:-1;RL0:=RL3&0F0)) .DO(SavB(RL0:=RL3)) ; DATAN := (.DO(RL0:&0F0)) EXC OW8_408 / EXOP2 ; UNOPB := .SAV(0C) EXC OW8_408 / EXOP2 ; UNOPL := .SAV(1C) EXC OW8_408 / EXOP2 ; LDREL : BL_DEL() RL0=='B'; JP Z,LDR_B; RL0=='L'; JP Z,LDR_L ...fall thru: LDR_W := .SAV(31) := LDR2RET INST2A := EVNBDYe "JR" Del CCCD .OUT("OE0"Re) OUTRe := "JP" .SAV(1E) Del CCCD := ("EI" .DO(RL0:=4) / "DI" .DO(RL0:=0)) SavB Del {"VI" .DO(RL0:=1) / "NVI" .DO(RL0:=2) / .DO(RL0:=0)} SavB .OUT("W7C00"WRe0 WRe0) := "SC" .OUT("H7F") <BL_DEL() RL0=='L'; JP Z,AROPL; RL0=='B'; JP Z,AROPB ...fall thru: AROPW := ; AROPW2 := EXOPW2 / OW_X0X8_R ; OW_X0X8_R := .OUT("W"Xc WRe0 Xc WRe8) OUTRe ; EXOP : BL_DEL(); RL0=='B'; JP Z,EXOPB ...fall thru: EXOPW := .OUT("HB3") ; ROTATE : BL_DEL(); RL0=='B'; JP Z,ROTB ...fall thru: ROTW := ROT2 ; ROT2 := { / .SAV(0)} .OUT("O"Re ORe4 Re) ; ROTB := ROT2 ; INPUT : BL_DEL(); RL0=='B'; JR Z,INB ...fall thru: INW.DO(SavB(RL0:=RL3)) ; DATA07 := (.DO(RL0:&0F8)) .DO(SavB(RL0:=RL3)) ; DATAL := {"#"} .DO(NOTR();RET NZ) ; ...DATAL := CMA { EXC / .DO(SAVNN(0))} ; MDATA := .DO(RL3:=-RL0;RH3:=0FF;if zero then RH3:=RL3) SAVNN ; MDATA1S ; LDR2S := .OUT("W0200"WRe0 Xc WRe8) OUTRe ; LDR_B := .SAV(30) := LDR2S ; LDR_L := .SAV(35) := LDR2S ; LDR2 := OW_08 OUTRe ; DJNZ2 := ; LDM := GETNN> SAVN OUTRe ; INST2B := "OR" .DO(RL0:=4) SAVAWB := "EX" .DO(RL0:=02C) SAVAWB := "IN" := ("RL" .SAV(0) / "RR" .SAV(4)) ; INST2C := "LD" := "CP" { .SAV(10) / .DO(RL0:=0A) SAVAWB} := ("SL" / "SR" /> ; EXOPW2 := OW8_408 / EXOP2 ; EXOP2 := OW_408 / EXOP2A ; EXOP2A := .OUT("W4000"WRe4 Xc WRe0 Xc WRe8) OUTRe ; AROPB := ; AROPB2 := EXOPB2 / OW_X0X8_R ; EXOPB := ; EXOPB2 := OW8_408 / EXOP2 ; := ( .OUT("H3D") OO_40 / .OUT("H3B") IN2) ; INB := ( .OUT("H3C") OO_40 / .OUT("H3A") IN2) ; IN2 := .SAV(4) OO_04 OUTRe ; OUTPUT : BL_DEL(); RL0=='B'; JP Z,OUTB ...fall thru: OUTW := .OUT("H3F") OO_04 / .OUD := .DO(RL3:=-RL0->RH3) SAVNN ; PDATA := SAVNN ; PDATA1D := .DO(RH3:=RL3) SAVNN ; DATA1or2 := (.DO(if RL0:-1<>zero then RL0==1)) .DO(SavB(RL0:*2)); ATRW := "@" ; ATRW_C := ; ATR := "@" ;  := .OUT("W1C09"WRe4) := .OUT("W5C09"WRe4) OUTRe ; LDMR2 := .OUT("W1C01"WRe4) INCDCNT OW_08 := .OUT("W5C01"WRe4) INCDCNT OW_0X8 OUTRe ; LDM2 := INCDCNT OW_08 ; MULTDW := Del  "SD" / "SU") .DO(R7:-2;INSTTYP:='W') INST3C ; INST3A := ORG := EVNBDYe "RET" Del .OUT("H9E") { .OUT("O"Re) / .OUT("H08")} := "POP" Del := "LDM" Del := "LDA" Del := "DIV" .SAV(1B) := "LDK" Del OUTRe ; CPIMM1 := ( .OUT("W0001"WRe4 WRe8) / .OUT("W4001"WRe4 Xc WRe8) OUTRe) ; CPOPB := AROPB / Ig .SAV(0C) OO_40 OUTRe ; OUTB := .OUT("H3E") OO_04 / .OUT("H3A") OO_40 OUTRe ; OUT2 := .SAV(6) ; OUTIDR := BL_DEL EXC ; INIDR := BL_DEL EXC ; IOIDR2 := .CMA0 := "," ? ; CMA := CMA0 / Del ; ATR_C := ; ADDRI_C := ; RW_C := ; RB_C := ; BSOFFST := .DO(PUSH R7) {("("/"[") .DO(POP R3) / Ig .DO(POP R7;RET)} ( .SAV("H"WRe8) EXC .SAV(40) /  ; MULTDL := Del ; EXTSN : BL_DEL() RL0=='B'; JP Z,EXTSB; RL0=='L'; JP Z,EXTSL ...fall thru: EXTSW := .SAV(0A) EXTS2 ; EXTS2 := .OUT("HB1") OO_04 ; EXTSB := .SAV(0) EXTS2 ; EXTSL := .SAV(7) EXTS2 ; ADSBC : BL_DEL(); RATAN> OWBD_04 ; INST3B := ("BIT" .DO(RL0:=026) / "SET" .DO(RL0:=024) / "RES" .DO(RL0:=022)) SAVAWB := ("AND" .DO(RL0:=6) / "XOR" .DO(RL0:=8)) SAVAWB := ("INC" .DO(RL0:=028) / "DEC" .DO(RL0:=02A)) SAVAWB := ("CLR" .DO(RL0:=8) / "COM1> OUTRe ; CPOPL: AROPL := ; AROPL2 := OW8_408 / EXOP2 := OW_08 OUTRe ; OW_08 := .OUT("W"WRe0 WRe8) ; OW_0X8 := .OUT("W"WRe0 Xc WRe8) ; OW_0X8_W_8 := OW_0X8 .OUT("W"WRe8) ; INCD : BL_DEL(); RL0=='B'; JP Z,INCDBDO(RL0:=03A) SAVAWB .OUT("W"WRe8 WRe4 WRe0) .OUT("W"WRe8 WRe4) ; LDCTL_ : BL_DEL(); RL0=='B'; JR Z,LDCTLB ...fall thru: LDCTLW := ( EXC .DO(RL0:=8) / .DO(RL0:=0)) SavB .OUT("W7D00"WRe0 WRe0 WRe4) ; LDCTLB := ("FL EXC .SAV(0)) (")"/"]") := .DO(POP R7) ; ADDRI := {("("/"[") (")"/"]") / .SAV(0)} ; ADDR16 := .DO(NOTR();RET NZ) HXWNSV ; ADDR := .DO(SEGMD==0;JR Z,ADDR16) "|" { ReK / .DO(R3:=RUNSEG)} .DO(PUSH R3) ReK (.DO(RH3==0)) .D L0=='B'; JP Z,ADSBCB ...fall thru: ADSBCW := OW8_408 ; OW8_408 := .OUT("W8000"WRe4 WRe0 WRe8) ; ADSBCB := OW8_408 ; CZSPV := .DO(RH1:=0) $(.DO(PUSH R1;CMA();POP R1;if zero then FLAG())) .DO(SavB(RL0:=RH1)) ; LDID : BL_DEL()" .DO(RL0:=0) / "NEG" .DO(RL0:=2)) SavB := ("ADC" .DO(RL0:=034) / "SBC" .DO(RL0:=036)) SAVAWB := "OUT" := ("LDI" .SAV(1) / "LDD" .SAV(9)) .SAV(8) EXC := ("CPI" .SAV(0) / "CPD" .SAV(8)) := ("RLC" .SAV(8) / "RRC" .S ...fall thru: INCDW := INCDCNT OW8_048 / INCD2 ; INCD2 := INCDCNT OW_048 := INCDCNT OW4_04X8_R ; OW4_04X8_R := .OUT("W4000"WRe0 WRe4 Xc WRe8) OUTRe ; INCDCNT := CMA DATA1_16 / .SAV(0) ; INCDB := INCDCNT OW8_048 / INCD2 ; BITOP : AGS" .DO(RL0:=9) / "FLAGS" .DO(RL0:=1)) SavB .OUT("H8C") OO_04 ; LDCITMS := "NSP" ("OFF" .DO(RL0:=7) / .DO(RL0:=6)) SavB ; SG := (.DO(SEGMD==0;COMFLG Z)) "SEG" ; RELAD8: RL0:='1'; JR RELAD RELAD12: RL0:='3'; JR RELAD RELAD16: RL0:='O(POP R1;RH3:=RL1;RES R3,15) SAVNN "|" := ( / ( / ReK .DO(if BIT R2,15 zero then R2:=RUNSEG;RL2:=0;PUSH R2) SAVNN .DO(POP R3))) SVNNCMRe := .SAV("AL"*) ; ... := ( ... / ( .OUT("W"WRe8 WRe4 WRe0) ; LDIDB := .OUT("HBA") LDID2 ; LDID1 := ; LDCPID2 := .OUT("O"ORe4 Xc Re) ; CPSID : BL_DEL(); RL0=='B'; JP Z,CPSIDB AV(0C)) := "TCC" BL_DEL CCCD ((.DO(INSTTYP=='W')) .OUT("HAF") / .OUT("HAE")) OO_40 ; INST3C := "LDR" := ("ADD" { .SAV(16) / .DO(RL0:=0) SAVAWB} / "SUB" { .SAV(12) / .DO(RL0:=2) SAVAWB}) := ("SLA" .DO(RL0:=9)BL_DEL(); RL0=='B'; JP Z,BITOPB ...fall thru: BITOPW := ( OW_0X8_W_8 / OW8_048) := OW_048 := OW4_04X8_R ; BITOPB := ( OW_0X8_W_8 / OW8_048) := OW_048 := .DO(POP R0) SAVR := (Id .DO(POP R1)) .SAV("A" .DO(RL1:->@R7') *NEDOT> / ReK SAVNN .DO(R3:=RUNSEG)) ... / .DO(R3:=RUNSEG)) SVNNCMRe ; ZSEGMT := "<<" ">>" ; SEGADR2 := ReK .DO(RH3:=RL3;RL3:=0;SET R3,15) (.DO(PUSH R3;ADDR16();POP R3)) ; OW_048 := .OUT("W"WRe0 WRe4 WRe8) ; OW3_884X0_R := .OU...fall thru: CPSIDW := .OUT("HBB") CPSID2 ; CPSID2 := ; CPSIDB := .OUT("HBA") CPSID2 ; CPID3 := .OUT("W"WRe0 WRe8 WRe4) ; CPID : BL_DEL(); RL0=='B'; JP Z,CPIDB ...fall thru: CPIDW := .OUT("HBB") ; CPID2 := := ("SRA" .DO(RL0:=9) / "SRL" .DO(RL0:=1)) SAVAFIXL := ("SDA" .DO(RL0:=0B) / "SDL" .DO(RL0:=3)) SAVAFIXL ; INST4A := "BYTE" BNR := DEFX := EVNBDYe "WORD" WNR := "PUSH" Del := "POPL" _C> OW4_04X8_R ; CCCD := .DO(PUSH R7) { .DO(POP R3) / Ig} / .DO(POP R7) .SAV(8); CCD := ("Z"/"EQ") .SAV(6) / ("NZ"/"NE") .SAV(0E) / ("C"/"ULT") .SAV(7) / ("NC"/"UGE") .SAV(0F) := "PL" .SAV(0D) / "MI" .SAV(5) / ("OV"/"PE") .SAV(4) / () ; EVNBDYe: BIT NCODE,0; RET Z Errm(); DEFT 'ODD BOUNDARY'; BYTE 0 FLAG: ...enter with RH1 set=0 or from prev. call if RL0:=@R7='C' then SETB RH1,3 else if RL0='Z' then SETB RH1,2 else if RL0='S' then SETB RH1,1 else if RL0='P' or RL0='V' then SETBT("W3000"W884 Xc WRe0) OUTRe ; LOAD : BL_DEL(); RL0=='L'; JP Z,LDL; RL0=='B'; JP Z,LDB ...fall thru: LDW := .SAV(33) OW_8084_R := := ( .OUT("H2F") OO_04 / .OUT("W0D05"WRe4) OUTRe) := ( ; CPIDB := .OUT("HBA") ; Test: JP TEST Del: JP DEL Icopy: JP ICOPY Copyin: JP COPYIN Copy: JP COPY Outset: JP OUTSET Out: JP OUT OutN: JP OUTN Sav: JP SAV SavB: JP SAVB Gen: JP GEN Zp: JP ZP Err0: JP ERR0 Re: JP RE Xc: Del := "LONG" LNR := "CALR" Del .OUT("HD0") OUTRe := "CALL" Del .SAV(1F) .SAV(0) := "LDAR" Del .SAV(34) := "MULT" .SAV(19) := "DIVL" .SAV(1A) := "IRET" .OUT("H7B00") := "DJNZ" Del POPR2 / POP2 ; POP2 := OW_408 := .OUT("W4000"WRe4 WRe0 Xc WRe8) OUTRe ; POPR2 :=  RH1,0 RET NZ; R7:+1==R7; RET SOMETHG: COMM(); CPB @R7,#0D; COMFLG Z; RET INST: ZINST := SETDLR Del .DO(W.EXTADR) Latch2 / RINST ; RINST := PIKINST / EVNBDYe .DO(CALL ZXINST) ; PIKINST : RL0==2; RET C; RL0==6; RET UGT if RH0:=@(R3-1W> .OUT("H6F") OO_04 OUTRe / .OUT("W4D05"WRe4) OUTRe OUTRe) ; LDRW2 := .SAV(1) OW3_884X0_R := .SAV(21) EXC ; LDB := := ( .OUT("H2E") OO_04 / .OUT("W0C05"WRe4) OUTRe) := JP XC WRe0: JP WRE0 WRe4: JP WRE4 WRe8: JP WRE8 OUTRe: JP OUTRE SHIFTL : BL_DEL(); RL0=='B'; JP Z,SLB; RL0=='L'; JP Z,SLL ...fall thru: SLW := SL2 ; SL2 := OO_40 { / .DO(SAVNN(1))} OUTRe ; SLL := SL2 ; SLB := OO_40 {> .DO(RL0:='W') DJNZ3 := "LDPS" Del ( .OUT("W3900"WRe4) / .OUT("W7900"WRe4) OUTRe) ; INST4B := ("LDIR" .SAV(1) / "LDDR" .SAV(9)) .SAV(0) EXC := ("CPIR" .SAV(4) / "CPDR" .SAV(0C)) := ("CPSI" .SAV(2) / "CPSD" .SAV(0A))  OW8_408 ; POPL_ := .SAV(15) POPR2 / POP2 ; ATR_SP := CMA / PKSP ; PUSHW := .SAV(13) {CMA / PKSP OW_408} := PKSP PUSHW2 ; PUSHW2 := OW8_048 / PUSH2 := .OUT("W0D09"Xc WRe4) OUTRe ? ; PUSH2 := OW_048)<>'B' and RH0<>'L' then RH0:='W' PUSH R0; PIKINSTA(); POP R0; RET Z PUSH R0; PIKINSTB(); POP R0; RET Z PIKINSTC(); RET PIKINSTA: RL0==2; JP Z,INST2A; RL0==3; JP Z,INST3A; RL0==4; JP Z,INST4A RL0==5; JP Z,INST5A; RL0==6; JP Z,INST6A; RET PIKINSTB: .SAV(32) OW_8084_R := ( .OUT("H6E") OO_04 OUTRe / .OUT("W4C05"WRe4) OUTRe OUTRe) ; LDRB2 := .SAV(0) OW3_884X0_R := .SAV(20) EXC := EXC Ig .OUT("OC0"Xc Re) OUTRe ; LDL := .SAV(37)  / .DO(SAVNN(0101))} OUTRe; SHIFTR : BL_DEL(); RL0=='B'; JP Z,SRB; RL0=='L'; JP Z,SRL ...fall thru: SRW := SR2 ; SR2 := OO_40 { / .DO(SAVNN(0FFFF))} OUTRe ; SRL := SR2 ; SRB := OO_40 {  := ("OTIR" .DO(RL0:=2) / "OTDR" .DO(RL0:=6)) SavB := ("INIR" .DO(RL0:=0) / "INDR" .DO(RL0:=8)) SavB := "TSET" .SAV(6) ; INST4C := "TEST" .SAV(4) := "EXTS" ; INST5A := EVNBDYe "PUSHL" Del := "MULTL" .SAV; RET FLGBDOT: DOTSTATE:=BYT; RET FLGWDOT: DOTSTATE:=WRD; RET FLGNODOT: DOTSTATE:=0; RET BDOT: DOTSTATE==BYT; RET WDOT: DOTSTATE==WRD; RET NODOT: DOTSTATE==0; RET CKXTYPB: XTYP==BYT; RET ACCR: BITB ACCREG,ADDFLG; RET ACCNOTR: BITB ACCREG,ADDFLG; COMFLG Z;  SAVed PUSH R3; PUSH R1 EQVRW() ...chg to equiv. word reg. SavB(RL0:=RL3) ...save reg. POP R0 RWTORR(RL0:) ...if seg. mode, make SP even RL0==0; JP Z,Err SavB() ...save SP OW_408() POP R3; RET CKFREE~ ...chk if reg. R3 is free; preserve all rVAL, =1 if addr is based rel. to R13 ASNVAL: WORD ASNTYP: BYTE [1] ...B=1,W=2,L=4,F=8 ASNREG: BYTE [1] ...reg. code; bit 7=1 =>addr instead ASNADD: WORD [1] ...value of specified WORD or BYTE ENDXST~ ACCVAL: WORD ...reg (or addr) currently used as accu used yet, get it, ret. Z=1 if free or prev. ...find next free reg.->RL0, looking at spec. first; if found, ret. Z=1 ...if none free, ret. one in diff. word reg. from most recent, Z=0 ... ...R7 must pt. to text R5:=REGSP while R5<>^REGSTK do begin R5:-(18) := "DBJNZ" Del .DO(RL0:='B') DJNZ3 ; INST5B := ("CPSIR" .SAV(6) / "CPSDR" .SAV(0E)) := "LDCTL" ; INST6A := EVNBDYe ("SETFLG" .SAV(1) / "RESFLG" .SAV(3) / "COMFLG" .SAV(5)) Del .OUT("H8D") OO_40 ; *ZRET ACCNOTRW: ACCNOTR(); RET Z; CKB(); RET CKASNMT: ASNVAL==0; COMFLG Z; RET ASNNOTACC: CKASNMT(); RET NZ; ASNVAL==ACCVAL; COMFLG Z; RET AASND: CKASNMT(); RET NZ; BITB ASNREG,ADDFLG; COMFLG Z; RET MKXTYP: ...if xtyp not determined, set according to WB XTegs. PUSH R3; PUSHL RR4 EQVRW()->R4 ...equivalent word reg. R5:=REGSP CKFLUP~ R5==^REGSTK; JR Z,ISFR; R5:-2 ...go backwards thru REGSTK R3:=@R5 if BIT R3,PSHFLG not zero then begin RES R3,PSHFLG; R3==R4; JR Z,ISFR ...if PUSH of reg. found mulator in EXPR ACCTYP: BYTE [1] ...B=1,W=2,L=4,F=8 ACCREG: BYTE [1] ...reg. code; bit 7=1 =>addr in ASNADD instead REGSP: WORD [1] ...SP of REGSTK (init. REGSTK) PSHFLG~ EQU 12 ...bit of item on REGSTK, =1 if `push' entry REGSTK: ;WORD [18] ...save A2; BIT @R5,PSHFLG; JR Z,RQR1 end ...get prev. REG; if none do: R4:=0FFFF; JR RQR2 RQR1~ EQVRW(R3:=@R5)->R4 RQR2~ RL3:=ASNFLG if BITB RL3,RSPECB not zero and BITB RL3,REGVARB zero and RL0:=ASNTYP=EVL then begin ...chk eval. level matches ASNTYP ... AP RRL0 RQD0 NOTR RQ RRL RB RW RW07 PKRNZ PKR RXSV RXF RN00 RN0 REG2 REGBX *ZAPALL R=^OW_8084_R,^CPIDB *ZAPALL R=^SHIFTL,^SOMETHG *ZAPALL R=^PIKINST,^INST6A *PACK ALL XSV RXF RN00 RN0 REG2 REGBX *ZAPALL R=^OW_8084_R,^CPIDB *ZAPALL R=^SHIFTL,^SOMETHG *ZAPAYP==0; RET NZ XTYP:=BYT; if WB=1 then XTYP:=WRD; RET WTOXTYP: XTYP:=WRD; RET BTOXTYP: XTYP:=BYT; RET WBEQEVL: RL0:=WB; RH0:=EVL; if RL0=0 then begin RH0==BYT; RET end RH0==WRD; RET W_EVLB: TYPGTEVL~ RH0:=BYT; if WB<>0 then RH0:=WRD if RH0>EVL then R0==first JR CKFLUP end EQVRW() ...if reg on stk=byte, convert to word R3==R4; JR NZ,CKFLUP ...not free (reg. found): RESFLG Z ISFR~ POPL RR4; POP R3; RET RESREG: ...restore prev. ACC; if pushed, pop it + any intervening pushes R5:=REGSP; CCs used & pushed ENDRSTK~ BYTE [1] ...set by RDSTACK: ADMODE: BYTE [1] ...80=R;40=DA,X;0=IR,010=postinc,011=postdec;20=IM;21=BA;61=BX WB: BYTE [1] SRC: BYTE [1] ADDTACD: BYTE [1] OP: BYTE [1] ADDTA: WORD [1] ITMSW~ BYTE [1] ...used by ITEM NARG: BYTE  if BITB ASNFLG,REGVARB not zero then begin ... ...if RASN=reg. var. & not asnop must not be any more to expr ... NOMORE(); JR NZ,RQR3 ... end RESB ASNFLG,RSPECB; CKFREE(R3:=ASNVAL); RET Z R5:=R3; EQVRW()==R4; R3:=R5; RET end RQR3~ DEFRLL R=^PIKINST,^INST6A *PACK ALL ...test for quad reg. RQD0(); RET NZ; JR RXSV RRNZ: RRL0(); RET NZ; RL0==0; JR NZ,RXSV; JR RXF ...do RRL except RR0 fails RRL: ...test for double reg. & save code RRL0(); RET NZ; JR RXSV RB: ...test for byte reg. & saveR0 else RESFLG Z; RET CKEVLB: EVL==BYT; RET WTOEVL: EVL:=WRD; RET BTOEVL: EVL:=BYT; RET WBEQACC: RL0:=WB; if ACCTYP=WRD then begin RL0:-1; RET end RL0==0; RET W_ACCB: RL0:=WB-1; RET NZ; ACCTYP==BYT; RET CKIMMB: ...chk if (XTYP=B and EVL=B and not WDOT) orRH1:=0 repeat R5:-2; RH1:+1 until BIT @R5,PSHFLG zero; R3:=@R5->ACCVAL RH1:-1; RET Z ...go back to prev. ACC, ret. (restoring ACC) if nothing above it PUSH R7; R5:->R7 ...save pos. R3->R1 ...prev. REG PUSH R3 EQVRW(); SET R3,PSHFLG; R3->R2 R5:[1] ...#args in printf stmt ...used by FUNC stuff: PVARCNT~ WORD [1] NPARMS~ WORD [1] NINPARM~ WORD [1] VARTYP~ BYTE [1] REGVSC~ BYTE [1] REGVFLG~ WORD [1] SVRFLG~ WORD [1] LOCSPC~ WORD [1] P1SIZ~ WORD [1] P2SIZ~ WORD [1] P3SIZ~ WORD [1] PO1SIZ~ WORD [1]WB() repeat if EQVRW(@R5)<>R4 then begin CKFREE(R3:=@R5); RET Z end R5:+2 until R1:-1 zero; DEFRWB() repeat EQVRW(R3:=@R5')==R4 until not zero; R3:=@R5[-2]; RET ...REQRDEFNS: ...req. a default reg.<>SRC REQRDEF: ...req. default (primary or secies at R_SP LDL RR2,R14_ repeat PUSH R0; PUSHL RR2; RDR1aRR2() Dump1(R2:=RPC_; R1); POPL RR2; POP R0 R3:+2 until RL0:-1 zero; RET BRK~ PROC ...expects RR2 pointing to brk address; RL0=repeat count ...ret. Z=0 if brks used up or in rom, else Z=1 BDOT if CKXTYPB() then begin CKEVLB(); RET NZ; DOTSTATE==BYT; RET UGT; R0==R0; RET end BDOT(); RET NONSEGMD: SEGMD==0; RET WREGNZ: ...chk if item on STACK=word reg.<>R0 RD1ST(); RL0==080; RET NZ; RDNXT(); RL0:-1; RET NZ RDNXT(); RL0==0; COMFLG Z; =REGSP repeat R3:=@(R5:-2)==R1; JR Z,SHFTSTK until R3=R2; PUSH R7; R5:->R7; R5:=REGSP repeat R5:-2; POPR() until R5=R7; ...if prev. ACC pushed, pop it + any pushes above it on stk R5:->REGSP; POP R7 SHFTSTK~ R3:=R7+2; R1:=REGSP-R3 if R1<>0 then LDI PO2SIZ~ WORD [1] RETADR~ WORD [1] ...0FFFF ...used by Call FUNC stuff: PARMDTA~ ...LONG; following 4 bytes must be together: PARMCNT~ WORD [1] PARMFLG~ WORD [1] ...bits=1: 0:DECSP, 1:long DECSP, 2:after 2nd parm, ... 3:after 3rd parm, 5:OPARMS ... ..ondary) reg. for ACC RL0:=ASNFLG->stk; RESB ASNFLG,RSPECB REQR0() RL0:=stk->ASNFLG JR REQR2 ... ...REQRODD: REQR0(); RH0:=flag ...do REQR for odd REG ... BITB RL3,0; COMFLG Z; ...JR REQAGN ... ...REQR07: REQR0(); RH0:=flag ...do REQR but must get R0- PUSH R7; PUSH R0; LDL RR6,RR2; PUSHL RR6 if CKBRKPT() not then begin ...chk if not already brkpt. PUSH R7; CKBRKPT(R7:=0FFFF) ...if not, look for empty slot POP R7; JR NZ,NOBRK ...err if no empty slot R3<->R7; RDR1aRR2(); R1:->@R7 ...copy b RET CKBREQR: ...unless CKIMMB satisfies, set EVL=W; REQR if CKIMMB() not zero then WTOEVL(); REQR(); RET CHK1_16: ...chk if R3 in range 1_16; if doing byte then ignore RH3; ret. RL3:-1 if CKB() not then begin CK1_16: RH3==0; RET NZ end RL3:-1; RL0:=RB @R7,@R3,R1 ...shift back REGSTK from @R3 to end back 1 place R7:->REGSP ...update REGSP POP R3; PSHREG(R3) POP R7; R0==R0; RET DECRSP: ...dec REGSP; if backing up over assigned reg, make it avail. again if @(R3:=REGSP-2->REGSP)=ASNVAL then SETB. 6:PUSH done RAM: ADDR $ ...***************** ORG ROM ...program & init'd data BYT: EQU 1 WRD: EQU 2 ...the following 2 pairs must each be together: DEFRWX: WORD; BYTE WRD 1 DEFRW: WORD; BYTE WRD 3 ...default primary word accumulator DEFRW2: WORD; BR7 ... BITB RL3,3 ...REQAGN: if not zero then begin REQR0(); SETB ASNFLG,RSPECB end ... else RH0:->flag ... JR REQR2 ... REQR: ...request a register to use as an accumulator (->R3 & ACCVAL) REQR0() REQR2~ if not zero then PUSHR() ...if no reg. free, do Pkpt word if PutBrkW() not zero then begin ...set bkpt NOBRK~ POPL RR2; POP R0; POP R7; RET ...ret. Z=0 if rom end R3<->R7; R3:+2; SET R6,15; LDL @R3,RR6 ...save brk address end CKBRKPT(POPL RR6); POP R0; RL0:->@(R3+3) ...store repeat couRL3&0F0; RET JUST0: ...chk for "0" not immediately followed by a hex digit CPB @R7,#'0'; RET NZ R7:+1; if Hexd() then begin R7:-2; RESFLG Z; RET end R0==R0; RET INITXST: XTYP:=0; DOTSTATE:=0; ASNFLG:=0; EVL:=BYT; ASNVAL:=0; RET INITRSP: REGSP:=^REGSTK ASNFLG,RSPECB R0==R0; RET GETSTKLVL: ...ret. R3=2*#push entries on rstk R5:=REGSP; R3:=0 while R5<>^REGSTK do begin R5:-2 if BIT @R5,PSHFLG not zero then R3:+2 end RET POPR~ ...put out pop of reg. @R5; save R5 PUSH R5; R3:=@R5; RES R3,PSHFLGYTE WRD 5 ...default secondary word acc. DEFRBX: WORD; BYTE BYT 9 DEFRB: WORD; BYTE BYT 0B ...default primary byte acc. DEFRB2: WORD; BYTE BYT 0D ...default secondary byte acc. *ZAP SavB SavB: JP SAVB SVXTYP: if begin CKXTYPB(); RL0:=1 end then RL0:USH REQRX: PSHREG() ...put on REGSTK R3->ACCVAL; R0==R0; RET PSHREGP~ ...push word reg. corres. to reg in R3 on REGSTK, mark as PUSHED EQVRW(R3) ...if byte, must push word reg. SET R3,PSHFLG ...fall thru: ... PSHREG: ...put R3 on REGSTK; preserve Rnt POP R7; R0==R0; RET PutBrkW~ ...put out break word @RR2, ret. Z=0 if rom WRR1aRR2(R1:=0E00) CK0E00~ RDR1aRR2(); R1==0E00; RET ...ret. word @RR2 in R1 BRKSOFF~ ...remove all breakpts. R3:=^BRKLST-2; RH1:=NBRKS repeat R3+6 until R0:=@R3<>0FFFF or R; RET PROC: ...entered with "C"Id on STACK ...push regs. used other then REG, then REG; save state; load args., ... do CALL; recall state; set REG=default (or if spec., do load) PUSH R7; R5:=^REGSTK; R7:=REGSP R3:=ACCVAL; R4:=EQVRW() PUSH R3 while R; OPOP(); POP R5; RET POPRS: ...pop all regs with `push' entry on rstk ...compress other entries together R5:=REGSP while R5<>^REGSTK do begin R5:-2 if BIT @R5,PSHFLG not zero then begin POPR() R3:=R5+2; R2:=R5 if R1:=REGSP-R3<>zer=0; SavB(); RET SVREGWB: SVREG() ...cont: SVWB: RL0:=0; if ACCTYP=WRD then RL0:=1; SavB(); RET SVREG: SavB(RL0:=ACCREG); RET SVREGE: SavB(RL0:=ACCREG; RESB RL0,0); RET SVRWB: PUSH R3; SavB(RL0:=RL3); POP R3 RL0:=0; if RH3=WRD then RL0:=1; SavB(); RET CK3 R3->@(R1:=REGSP); R1:+2->REGSP; RET PUSHR~ ...put out PUSH of reg. R3 (as W) + put on REGSTK; save R3 PUSH R3 PSHREGP() ...put on REGSTK, mark as pushed POP R3 ...fall thru to do push: ... OPUSH: ...put out PUSH of reg.# in R3 (saves R3) RL0:=09...extended Z8000 stuff: ...11/3 RL3=default byte ...11/5 arrays (AA[n] where AA=BYTE or WORD no longer=array; label,ADDR yes)) ROM: ADDR $ ...***************** ORG RAM ...uninit'd data XSTATE~ ...the following down to ENDRSTK must be together: DOTSTA5R4 then begin CKFREE(R3:=@R5); if not zero then PUSHR() end POPL RR4; R5:+2 end POP R3 CKFREE(); if not zero then PUSHR() POP R7 R15:-(R1:=^ENDRSTK-^XSTATE)->R5 R3:=^o then LDIRB @R2,@R3,R1 R2:->REGSP end end RET ...POPRS: ...pop all regs with `push' entry on rstk ... R5:=REGSP ... while R5<>^REGSTK do begin ... R5:-2 ... if BIT @R5,PSHFLG not zero then POPR() ... end ... RET RDSTACK: ...read items on SVAR: CKWD(); RET Z; CKBT(); RET Z; CKBASWD(); RET Z; CKBASBT(); RET CKBASD: CKBASWD(); RET Z; CKBASBT(); RET CKBTS: CKBT(); RET Z; CKBASBT(); RET CKBT: RL0==BYTET; RET CKWD: RL0==WORDT; RET CKBASBT: RL0==BASBYTT; RET CKBASWD: RL0==BASWRDT; RET CKP: RL0==PR3 OPP2~ ...put out PUSH/POP (depending on code in RL0) of reg# in R3 (save R3) PUSH R3; SavB() ...save op code POP R3; PPEX(RL1:=15) RET ... OPOP: RL0:=097; JR OPP2 ...POP OPUSHL: RL0:=091; JR OPP2 ...PUSHL OPOPL: RL0:=095; JR OPP2 ...POPL PPEXSTK:TE: BYTE [1] ...if "B.","W.",etc. XTYP: BYTE [1] ...type of expr (B,W,L,F) EVL: BYTE [1] ...evaluation level of expr ASNFLG: BYTE [1] ...bits of ASNFLG: ASNOPB~ EQU 0 ...set if spec. reg. or addr. is init. acc. RSPECB~ EQU 1 ...set if ASNREG to be tXSTATE; LDIRB @R5,@R3,R1 ...save state CALL PROC2 ...load args., do CALL R5:=^XSTATE; R1:=(^ENDRSTK-^XSTATE)/2 LDIR @R5,@R15,R1 ...restore state R0==R0; RET ...DEFRWB: CKEVLB(); R5:=^DEFRB; RET Z; R5:=^DEFRW; RET DEFRWB~ ...ret. R5=^default regs. fTACK into variables ...if flag for post inc/dec present, pop it off STACK RD1ST(); RL0:->ADMODE RDNXT(); RL0:->WB; RDNXT(); RL0:->SRC if RL0:=ADMODE&060 not zero then begin ...if bit 5 or 6=1 RPI2(); RL0:=@R3->ADDTACD if RL0='H' then begin PUSH OCT; RET CKALAB: RL0==LABLT; RET Z; RL0==ADDRT; RET CKEQU: RL0==EQUT; RET CKUNDEF: RL0==0FF; RET CKBARRY: RL0==BARRAYT; RET CKWARRY: RL0==WARRAYT; RET CKB: ACCTYP==BYT; RET CKW: ACCTYP==WRD; RET CKEVN: BITB ACCREG,0; RET ASNOP: BITB ASNFLG,ASNOPB; COMFLG Z R3:=ACCVAL ...R3=reg. to push,pop, or ex with data stk PUSH R3 if begin NBR(); RL1:=15 end then RL1:=RL3&0F POP R3 ...fall thru: ... PPEX~ ...do common stuff for PUSH,POP or EX reg in R3,@SP; save R3 ...enter with RL1=reg. used as SP, 1st byte instaken by next acc. request REGVARB~ EQU 2 ...set if ASNREG=reg. variable & not asnop XDEFB~ EQU 3 ...set when want to use extra default reg. ADDFLG~ EQU 7 ...bit of ASNVAL/ACCVAL, =1 if addr in ASNADD instead of reg. BASFLG~ EQU 6 ...bit of ASNVAL/ACCor evl., R1=cnt of regs. if begin CKEVLB(); R5:=^DEFRW end then R5:=^DEFRB R1:=2; BITB ASNFLG,XDEFB; RET Z; R5:-2; R1:+1; RET EQVRW~ ...get equivalent word reg. for reg. in R3 if RH3=BYT then RESB RL3,3; RH3:=WRD; RET REQR0~ ...if reg. specified & not R3; InhexW(R3+1)->ADDTA; POP R3 end end RET RDSTACKO: RDSTACK(); RDNXT(); RL0:->OP; RET ...also read op RD1ST: RPI(); PUSH R3; Inhex(); POP R3; RET RDNXT: RPI2(); PUSH R3; Inhex(); POP R3; RET GETMODE: RL0:=ADMODE; RET GETDCON: ...if ADDTA is defineTEM> { ? / LDREG SVREG DECRSP}} .DO(CALR RESXST) ; REXPR := SVXST SVACCWB RESXST / RESXST ; ARRAY1 := .DO(R3->R5) "[" .DO(PUSH R5) GETVAL .DO(PUSH R3) ( .DO(POP R5;POP R1;R3:*R1+R5) SVADDR / .DO(POP R3ORP2>) ; STORP2 := "stk" .SAV(093) PPEXSTK := "flag" .DO(07D0A) { .DO(08C09)} OUTFLG ; OUTFLG := .DO(PUSH R3) SVREG .DO(POP R3) .OUT("W"HLout WRe4) ; EX_P2 := "stk" .SAV(02D) PPEXSTK ; LDREG := RDSTACK MKXTYP (WBEQEVL / SLtoEVL) REQR OUTLDUSH R6; Ig(); POP R7; RET ...SHWSTK: PROC; PUSHL RR0; PUSHL RR2; R0:=flag->stk; R3:=FREE; RH0:=0 ... while R3>^STACK do begin ... RL0:=@(R3:-1); R3:-R0->R2 ... repeat printf("%c",RL1:=@R2); R2:+1 until RL0:-1; ... printf(" ") ... end ... ?; R0:=stk-OTEQU> { PROC0 / VAR} := SMPROC := "()" SVDEF ; ITM2 := (.DO(if ITMSW=0 then ZNN2I() else ZNN2())) ReK { .DO(RH3:=RL3) SVIMM .SAV(0) / SVIMM .SAV(1)} .SAV(20) := "^" ( GETVAL SAVNN SVIMMW2 LDREG SVREG .OUT("W81D0"WRd const. ret. Z=1, value in R3 ADDTACD=='H'; RET NZ; R3:=ADDTA; RET GETDNN: RPI(); CPB @R3,#'H'; RET NZ ...get defined value from top of STACK InhexW(R3+1); R0==R0; RET TSTSRCNR: ...return Z=1 if SRC<>current ACC RL0:=ACCREG==SRC COMFLG Z; RET ...S) SAVNN SEGMT .DO(POP R3) ) := .DO(NODOT();JP Z,NOGOOD) ...bkup if no "[" or "x." GETVAL SVADDR ; ARYINDX := .DO(R3==1;JR NZ,AIDX2) INDX2 ; ...R3=size AIDX2 := "]" RD1ST .DO(PUSH R0) SavB .DO(POP R0) SavB .OUT("W8100"WRe4 WRe0) ; . := LDDEFSL ; ...load src. level portion of ACC (=default reg.) OPREG := RDSTACKO {WBEQACC / ACCSTD1O ACCSTD2 / LDDEFSL SVREGWB8 RESREG RDSTACKO} OUTOP ; STORREG := RDSTACKO (WBEQACC / ACCSTD1 ACCSTD2) OUTSTOR := { .DO(PUSH>flag; POPL RR2; POPL RR0; RET ...SHWRSTK: PUSHL RR4; PUSH R0; RH0:=flag; R4:=REGSP; R5:=^REGSTK ... printf("---") ... while R5<>R4 do begin printf("%W ",@R5); R5:+2 end ... ?; RH0:->flag; POP R0; POPL RR4; RET ...FLAGCHG: ...tmp; call from LDREG after Re0) SVREGWB8 / SVA2ST SVIMMW2) := """ .OUT("J08"#1) LABSV Sr SREND .OUT("L"#1) Zp LKUPRe .SAV("H"HLout) Zp SVIMMW2 := "(" ")" := "-" LDREG SVREGWB .OUT("W8C02"WRe8 WRe4) SVREGWB8 := "stk" .SAV(97) CKBREQR PPEXSTK SVREGWB8 :=RCNEACC: ...chk if SRC<>ACCREG or OP=st,ex and ADMODE=R) ... RL1:=ADMODE ... if CKSTEX() then begin RL1==080; RET Z end ... if RL1&0EE zero or RL1=021 then begin NONSEGMD(); COMFLG Z; RET Z end ... ...for now, ignore SRC=double reg. cases ... ...assume..mult. word reg on STACK by init. R3 SVACCWB := SVASPEC / SVREGWB8 ; SVREGWB8 := SVREGWB .SAV(80) DECRSP ; SVXST : POP R1; R0:=^ENDXST-^XSTATE; R15:-R0->R5; R3:=^XSTATE LDIRB @R5,@R3,R0; JP @R1 RESXST : POP R1; R0:=(^ENDXST-^XSTATE)/2; R3:=^XS ACCVAL) REQRDEF .DO(R3->R5;POP R3) OUTLDR DECRSP} ACCtoSL OUTSTOR RESREG ; NOTW07 : ACCREG==8; RET ULT; R0==R0; RET ...chk ACC not word 0-7 LDDEFSL := REQRDEF .DO(PUSH R3) MAKEACCSL OUTLD .DO(R3:=ACCVAL;POP R5;R5:->ACCVAL) CONVRTUP ; ACCSTD1 := .DO(PUSHDSTACK; also RES BFLGCNT,0 @EXPR0 ... WB==0; RET NZ; RASND(); RET Z; ASNOP(); RET Z ... R5:=BFLGCNT ... if BIT R5,0 zero and R5<14 then begin ... R3:=LASTDE->BFLGBUF[R5]; BFLGCNT:+3 ... end ... RET ...CKBMSG: Errm(); DEFT 'CHK BYTE EXPR' ...RASND: CKASNM "flag" CKBREQR .DO(07D02) { .DO(08C01)} OUTFLG SVREGWB8 ; RWB := ( SavB .SAV(1) / SavB .SAV(0)) ; VAR := ( GETVAL SVADDR SVCURT_W / GETVAL SVADDR SVCURT_B / SAVBASVAL SVCURT_W / SAVBASVAL SVCURT_B  ACCTYP=WRD ... TSTSRCNR(); RET TSTNRR: ...ret. Z=1 if 2nd & 3nd items on STACK diff. RPI(); RDNXT() PUSH R0; RDNXT(); POP R1; RL0==RL1; COMFLG Z; RET CKIDX0: ...chk if indexed mode with disp=0 (& nonseg'd); called knowing mode=DA SRC==0; COMFLG Z; RETATE RL2:=flag; LDIR @R3,@R15,R0; RL2:->flag; JP @R1 ...save Z-flag WEXPR : INITXST(); SETSTW(); JR EXPR2 EXPR0 : INITRSP() ... EXPR : INITXST() ... EXPR2 : ASNMT() ...fall thru: EXPRA := ( ?( {AINCD / SVSPEC LDREG EXPMODS STORE} / R5;POP R3;PUSH R5) OT(); RET NZ; BITB ASNREG,ADDFLG; RET ...tmp GETTYPE: ...get type of id (=0FF if undefined; =PROCT if "(" follows) ...also mark ref'd if defined & looked up CPB @R7,#'('; RL0:=PROCT; RET Z; LKIDTYP(); RET ...*********** *ZAP Test Del Icopy Copyin Copy / .DO(R3:=2) ARRAY1 .DO(RET NZ) SVCURT_W / .DO(R3:=1) ARRAY1 .DO(RET NZ) SVCURT_B / .DO(R3:=1) ARRAY1 .DO(RET NZ) SVCURT / SVA2ST SEGMT INDEX SVCURT) .SAV(40) ; SAVBASVAL := GETVAL SAVNN SEGMT .SAV(0D) ; SVCURT_W := REQR) / AEQCON / LDREG STORE) COMP ; COMP := ?(Del "==" ) ; AINCD := .DO(PUSH R7) {("+" .DO(RL0:=068) / "-" .DO(RL0:=06A)) SavB { SVAASN .OUT("W"WRe8 WRe4 Xc WRe0 Xc WRe8) OUTRe .DO(POP R3) / Ig} / .DO(POP R7)} ;UTLDR .DO(POP R3;POP R5) CONVRTUP ; ...ACCSTD := .DO(PUSH ACCVAL) SLtoEVL DECRSP REQRDEF .DO(POP R5;PUSH R3;PUSH R5) CHGRSIZ .DO(R3->R5;POP R3;PUSH R5) ... OUTLDR .DO(POP R3;POP R5) CONVRTUP ; CHGRSIZ : ...convert reg. in R3 to size of reg. in R5 (down on Outset Out OutN Sav SavB Gen Zp Err0 *ZAP Re Xc WRe0 WRe4 WRe8 OUTRe RELOPD := EQ0 / RELOPD2 ; RELOPD2 := { { SVASPEC .OUT("W0C01"W884) OUTRe OUTRe .DO(RET) / SVASPEC LDREG}} .SAV(0A) / Ig ; EQ0 := { .SAV(4) SVROT> .SAV(1) / SVCURT ; SVCURT_B := .SAV(0) / SVCURT ; ATRP2 := SVCURT {"'" .DO(RL0:=010) / "~" .DO(RL0:=011) / .DO(RL0:=0)} SavB ; DISPBRKT := SAVNN EXC SVCURT ; PROC0 := .SAV("C"*) PROC PROC3 ; PROC3 := { .DO(R3:=DEFRB) SVRWB / B ...CKSTEX: OP==02C; RET NZ ...cont: CKSTOR: OP==02E; RET ...chk OP=STORE CKDIV: OP==01A; RET ...chk if op type (on STACK) = DIV CKMLT: OP==018; RET ...ditto MULT CKMLTD: CKDIV(); RET Z; CKMLT(); RET Z ...cont: CKMOD: OP==01B; RET CKMLT2: CKMLT();  JSTK1_16 := .DO(PUSH R7) ReK { .DO(RL0:=RL3) SavB { .DO(POP R3) / Ig}} / .DO(POP R7) ; AEQCON := { SVAASN .OUT("W4C08"WRe8 WRe4) OUTRe / SVAASN .OUT("W4C05"WRe8 WRe4) OUTRe OUTRe} ; EXPR1 := ?( { .DO(POP R3)} / .DO(POP R7) ; JSTCON := .DO(PUSH R7) { .DO(POP R3) / Ig} / .DO(POP R7); JSTCONSV := ReK { .DO(RH3:=RL3)} SAVNN .DO(R3:=DEFRW) SVRWB} .SAV(80) LDREG SVREGWB8 ; ...SMPROC := .DO(CPB @R7,#'a';RET C) ... ("putchar" .DO(W.07F45) / "getchar" .DO(W.07F44) ... / "read" .DO(W.07F42) / "write" .DO(W.07F43) ... / "open" .DO(W.07F40) / "close" .DO(W.07F41)) ... SAVNN PROC  RET NZ; if CKW() then begin RH3==0; RET NZ end RL3==2; RET ...chk if *2 TSTPWR2: ...chk if defined constant which is a power of 2 is on STACK ...ret. R3=value, R5=power ADMODE==020; RET NZ; ...SRC==0; RET NZ GETDCON(); RET NZ ...value->R3 RH1:=8; RE1> LDREG EXPMODS SVREGWB8) ; EXPTRM := ?( LDREG $ SVREGWB8) ; EXPMODS := $(EXPMOD1 / EXPMOD2) ; ASNMT := ...assumes INITXST done .DO(R7:->NEXTDE) ...for FNDAHD ( ?( .DO(RH5:=WRD) SETSPEC SETSTW) / in R5 (assumed same basic reg): CONVRTUP := .DO(RL0:=RL5) SavB .OUT("WC000"WRe8) ; ...for now, byte->word CONVRTDN := ?() ; ...load reg. in R3 into reg. in R5 (assumed same level): OUTLDR : PUSH R5; SavB(RL0:=RL3); R0:=@R15; SavB(RL0:); POP R5 RL0:=RH5; NOMORE := MORE1 .DO(COMFLG Z) ; MORE1 := Del.DO(RL0:=@R7=='+';RET Z;RL0=='-';RET Z;RL0=='|';RET Z;RL0=='&';RET Z) := (".XOR." / "<->") BKUP / MORE2 ; MORE2 := Del .DO(RL0:=@R7=='*';RET Z;RL0=='/';RET Z;RL0=='%') ; LABSV := SVLAB .OUT("L"Pp) ; IdGETT :=PROC3 ; SMPROC := .DO(CPB @R7,#'a';RET C) (("putchar" .DO(W.07F45) / "getchar" .DO(W.07F44) / "close" .DO(W.07F41)) SAVNN / ("read" .DO(W.07F42) / "write" .DO(W.07F43)) .SAV("H2104FFFF"HLout) / "open" .SAV("H2102FFFF7F40")) PROC PROC3 ; if CKW() then begin BIT R3,15; RET NZ; RH1:=16 end ...if word, chk not neg. PUSH R3; RL0:=0 repeat if SRL R3 carry then begin RL0:+1; RL1:=RH1 end until RH1:-1; POP R3; RL0:-1; RET NZ ...test for exactly 1 bit set RL5:=16; if CKB() then RL5:=8 RL5 ?( .DO(RH5:=BYT) SETSPEC SETSTB)) := ?( { SETSTB .DO(RH5:=BYT) / SETSTW .DO(RH5:=WRD)} .DO(RL0:=RL5;RL5:=2**ADDFLG) { .DO(RL5:=2**ADDFLG+2**BASFLG+13)} SETASN .DO(GETVAL()->ASNADD)) ; ...CHKASN sets RL5=RL0, pre OUTLDR1(); RET OUTLDRW : RL0:=WRD ...fall thru: OUTLDR1 := {(.DO(RL0==BYT)) .SAV(0A0) / .SAV(0A1)} .OUT("W"WRe8 WRe0 WRe4) / ? ; OUTLD := GETMODE (.DO(RL0==080)) ?( OUTLD2 / Ig3) := (.DO(RL0==0)) OUTLD2 := (.DO(RL0==010)) I GETTYPE ; IdNOTEQU := .DO(CKEQU();JP Z,NOGOOD;R0==R0) ; ...IdNOTEQALB := .DO(CKALAB();JP Z,NOGOOD;R0==R0) ; VARID := {CKVAR / NOGOOD} ; ...WBID := .DO(CKWB();JP NZ,NOGOOD) ; ...SAVVALI := .DO(GETVAL();PUSH R3) "[SVIMMW2 := .SAV(0) .SAV(1) .SAV(20) ; EXPMOD1 := Del "->" := ("+" .SAV(0) / "-" .SAV(2) / "|" .SAV(4) / "&" .SAV(6) / ".XOR." .SAV(8)) := "<->" .SAV(2C) ( RESREG STORREG / Ig ) ; EXPMOD2 := Del ("*" .SAV(018) / "/" .SAV(01A):-RL1; RH5:-RH5; RET CHKASN: ...chk for (":=" / (":"/CPOP) set ASNOPB of ASNFLG) Z=1 / BKUP ...(CPOP is "=","<", or ">"); preserve RL0 & store in RL5 R0:->R5; Del() if RL0:=@R7=':' then begin R7:+1 CPB @R7,#'='; JR NZ,ISASNOP R7:+1; JR ISASN serves R0 ISW : RL0=='W'; RET NZ; RL0:=RL1; RET ...RL1=value of reg. ISB : RL0=='B'; RET NZ; RL0:=RL1; RET SETSTW := WTOEVL WTOXTYP ; SETSTB := BTOEVL BTOXTYP ; SETSPEC : SETASN(); SETB ASNFLG,RSPECB if BITB ASNFLG,ASNOPB zero and RH0<>0 and FNDAHD() thgSAV0 OUTLD2 POSTINC := (.DO(RL0==011)) IgSAV0 OUTLD2 POSTDEC := (.DO(RL0==021)) { OUTLDIX0 / Ig .SAV(30) OUTLD3} := (.DO(RL0==020)) IgSAV0 { LDC / OUTLD2 OUTRe} := OUTLDIX0 := OUTLD2 OUTRe ; LDC := Ig4P SAVN SVREG .OUT(" ( .DO(POP R1;R3:+R1) SVADDR / .DO(POP R3) SAVNN SEGMT ) ... := .DO(POP R3) SVADDR ; SVADDR := SAVNN SEGMT .SAV(0) ; SEGMT := NONSEGMD := {(.DO(RH3==0)) .DO(R0:=RUNSEG;RES R0,15;RH3:=RH0;PUSH R3;Ig();POP R3) SAVNN} / .DO(W.RUN / "%" .SAV(01B)) ; RT_OP0 := RESOPREG ; RT_OP1 := RESOPREG ; RT_OP2 := RESOPREG ; RESOPREG := RESREG OPREG ; ...SVAASN := .DO(W.ASNADD) SAVNN SEGMT ; SVAASN := .DO(R3:=ASNADD) SAVNN SEGMT .DO(RL0:=ASNREG&0F) SavB SVXTYP ; end if RL0='=' or RL0='>' or RL0='<' and EXSYM() not then begin ISASNOP~ SETB ASNFLG,ASNOPB ISASN~ R0:=R5; R0==R0; RET end R0:=R5 NOGOOD: RESFLG Z BKUP: R7:=LASTDE; RET EXSYM~ CPB 1[R7],#'-'; RET NZ; CPB 2[R7],#'>'; RET ...must save LASTDE,R5 ZNN2en SETB ASNFLG,REGVARB endif RET SETASN : R5:->ASNVAL->ACCVAL; RET ASNMENT := INITXST ASNMT CKASNMT ; ITEM : RL0:=1; JR ITEMA ...ITEMs put ?numval,regval,type,mode on STACK ITEM0 : RL0:=0 ...drop thru: ITEMA := .DO(RL0:->ITMSW) ITM1 / ITM2 ; ITM1"OC0"Re) OUTRe := (.DO(if RH3=0 then RL0:=RL3&0F0)) .DO(PUSH R3) Ig4P SVREG .DO(POP R0) SavB OWBD_04 ; OUTLD2 := SVREG .OUT("W2000"W0884) ; OUTLD3 := SVREG .OUT("W"W0884) OUTRe ; OUTLDIX0 := IgSAV0 OUTLD2 ?(Ig) ; W0884 := WRe0 W884 ; Ig5P := .DO(PUSH R3) SEG) SVNNCMRe ; INDEX := "[" / .SAV(0) ; INDX2 := RWNZBRK / "]" ; RWEXPR := SVXST { { SVACCWB WTOEVL LDREG} SVREG DECRSP} .DO(CALR RESXST) ; ...inner {} not needed until have long type^ RWITEM := SVXST INITXST SETSTW { SVASPEC / .DO(R3:=ASNVAL) SVRWB .SAV(80) ; SVDEF := { .DO(R3:=DEFRB) / .DO(R3:=DEFRW)} SVRWB .SAV(80) ; STORE := ?( .SAV(2E) SVSPEC STORREG) ; STOR := .SAV(2E) ( RESREG STORREG / Ig FLGBDOT / FLGWDOT / FLGNODOT} .SAV(80) := "@" ( (RWNZ / RWITEM) {"[" .SAV(40) / ATRP2} / {"[" .SAV(21) / ATRP2} / "[" SAVNN SEGMT EXC SVCURT .SAV(40)) := / OUTOP1 ; OUTOP1 := GETMODE (.DO(RL0==080)) OUTOP2 := (.DO(RL0==0)) OUTOP2 := (.DO(RL0==010)) IgSAV0 OUTOP2R_P := .DO(PUSHL PARMDTA) STOR .DO(POPL PARMDTA) ; SETSTDEFW := INITRSP INITXST SETSTW .DO(R3:=DEFRW) REQRX ; ...SETREQRW2 := SETSTDEFW .DO(R3:=DEFRB) PSHREG REQR ; FIXDECSP := .DO(BIT PARMFLG,0) := .DO(R3:=PARMCNT;if BIT PARMFLG,1 zero then R3:-1|0ABF0) =RH6; JR UGE,NPLEXF end ... end ... if RL0=0D then begin ...NPLEXF~ RESFLG Z; RET ... end ... R5:+1 ... end ... RET NPARMLE: ...ret. Z=1 if #parms.<=RL0 (count #","s before ")") PUSH R7 RL0:->RH6; RL6:=0 while RL0:=@R7<>')' do begin if f endif RL0==0D; RET ...ret. Z=1 if @CR SKGOTIL: RL0:=@(R7:+1)==0D; RET Z GOTIL: repeat RL0:=@(R7:+1) until RL0=RH0 or RL0=0D; RET TST: Test: JP TEST Del: JP DEL Icopy: JP ICOPY Copyin: JP COPYIN Copy: JP COPY Outset: JP OUTSET Out: JP OUT OutN: JP OU->LOCSPC ...size (byte=2) of 1st param->P1SIZ, 2nd param->P2SIZ, 3rd->P3SIZ ...size of 1st output param->PO1SIZ, 2nd->PO2SIZ ...set SVRFLG to regs for later push/pop (locals>R5+R13) ...below: R4 keeps value for symbol, R5=^ into PVARTAB, R6=cnt R4:=0  POSTINC := (.DO(RL0==011)) IgSAV0 OUTOP2 POSTDEC := (.DO(RL0==021)) { OUTOPIX0 / REQR OUTLD SVREGWB8 RESREG RDSTACKO OUTOP} := (.DO(RL0==020)) IgSAV0 { ADDINC / OUTOP3} := OUTOPIX0 := OUTOP3 ; OUTOP2 := SVREG .OUT("W"W0884 WRSAVKW DEFINE Zp ; PARMLST := .DO(PVARCNT:=0;VARTYP:=BASWRDT) PVARLST .DO(NINPARM:=PVARCNT) {"->" } .DO(NPARMS:=PVARCNT) ; PVARLST := $( PVARID) ; PVARID := Del ; FUNC := PARMTYPS "{" LOCALS SETVALS FUNCBEG INSTGRPRL0=',' then begin RL6:+1==RH6; JR UGE,NPLEXF end else begin if PASSTUF(RL0:) zero then begin NPLEXF~ RESFLG Z; JR NPLEX end end R7:+1 end NPLEX~ POP R7; RET /ZAPALL TMPS /PACKALL ...*********** ZXINST := ZCONTROL / BEGEND / EXPR0 / TN Sav: JP SAV SavB: JP SAVB Gen: JP GEN Zp: JP ZP Err0: JP ERR0 Re: JP RE Xc: JP XC WRe0: JP WRE0 WRe4: JP WRE4 WRe8: JP WRE8 OUTRe: JP OUTRE D_CMA := Del "," ; INCSP : RL0:=0; JR ADJSP DECSP : RL0:=2 ...fall thru: ADJSP := .DO(R3==0;RET Z;PUSH R3) SavB R5:=^PVARTAB+NINPARM; R6:=NPARMS-NINPARM SETPVAL(); R1:->PO1SIZ ...1st output param. if any SETPVAL(); R1:->PO2SIZ ...2nd output param. if any R5:=^PVARTAB+NPARMS; R6:=PVARCNT-NPARMS+2 while R6:-2 not zero do begin ...local sym. offsets->sym table e8) ; OUTOP3 := SVREG .OUT("W"W0884 Xc WRe8) OUTRe ; OUTOPIX0 := IgSAV0 SVREG .OUT("W"W0884 Ig WRe8) ; ADDINC := { .DO(PUSH R0) Ig5P .DO(SavB(RL0:=RL3);POP R0) SavB SVREGWB .OUT("W"WRe8 WRe4 WRe8 WRe0)} ; OUTMLTD := { .D0 "}" FUNCEND ZAPS ; ...PARMTYPS : RL0:=0; JR VARTYPS ...LOCALS : RL0:=1 ...fall thru: ...VARTYPS := .DO(RL0:->VTYPFLG) ... $(XCOMS ("word" .DO(RL0:=BASWRDT) / "byte" .DO(RL0:=BASBYTT)) ... .DO(RL0:->VARTYP;if VTYPFLG=0 then PTYPLST() else PVARLST())) ;SPCINST ; BEGEND := "begin" INSTGRP "end" ; ZCONTROL := "if" ZSSEXPR "then" XCOMS ZINST XCOMS ZELSEST LABLReZ ?"endif" := "while" LABSV ZSSEXPR "do" XCOMS .OUT("J08"Xc Re) Zp LABLReZ := "repeat" LABSV Del ...?"endr" := "case .DO(POP R3) SAVNN .SAV(0) .SAV(1) .SAV(20) .DO(ACCVAL:=WRD*0100+15) OPREG ; PROC2 := "(" .DO(PARMCNT:=0;PARMFLG:=0) {OPARMS / PARAMS POPRS} OUTRe .DO(R3:=PARMCNT) INCSP STPARMS FIXDECSP ")" := OUTRe ; PARAMS := SETSTDEFW .DO(PUSHL PARMDTA) INSTLIST .D R13:=@R5'; GETTYP() ...RL0=type if CKBASBT() not then begin R4:+1; RES R4,0 end SETVAL(R4) ...saves R0 R4:+1; if RL0=BASWRDT then R4:+1 ...if long then more end R4:+1; RES R4,0; R4-PO1SIZ-PO2SIZ->LOCSPC R5:=^PVARTAB ...do input parms. 1,O(PUSH R3) Ig5P .SAV(6) .DO(POP R3;R3:-1) SVIMM SVWB .SAV(0) OUTOP3 / Ig5P .SAV(0) SVREGWB .SAV(80) OUTOP2 / .DO(R3:=R5) { .DO(RH3:=0FF;RL3:=-RL3)} Ig5P { .DO(RH3:=RL3) SAVNN .SAV(1) / SAVNN .SAV(9)} SVREGWB .OUT("WB200"WRe8 WRe4 PARMTYPS := $(XCOMS { $( PTYPID)} ?";") ; ...PTYPLST := $( ) ; PTYPID := Del .DO(RL0:=VARTYP) SETTYP ?() ; LOCALS := .DO(REGVFLG:=0) $(XCOMS ( PVARLST / .DO(SETB RTYPFL" IFINST ACCtoREG XCOMS "of" CASEP2 "end" ; REPTEND := "until" XCOMS { SVREG EXC LKUPRe SAVKW Zp { .DO(RL0:='B') / .DO(RL0:='W')} DJNZ3 / ZSSEXPR EXC LKUPRe .DO(R2:=RUNSEG) SAVKL Zp DEFINE Zp} ; CASEP2 := SVLAB $ ?("else" ZINSTP O(POPL PARMDTA) "," ACCtoREG .DO(R7:-1) $( { .DO(RET) / IPARM2 / IPARM3 / IPARM}) ; OPARMS := Del "->" .DO(SET PARMFLG,5) {.DO(RL0:=2) NPARMLE / DECSP_N} ; IPARM2 := (.DO(BIT PARMFLG,2;SET PARMFLG,2)) ? ; IPARM3 := (.DO(BIT PARMF2 & 3; update R4,R5,R6: R1:=0 if R6:=NINPARM>4 then begin R5:=^PVARTAB+4 SETPVAL() end R1:->P3SIZ R5:=^PVARTAB SETPVAL(); R1:->P1SIZ SETPVAL(); R1:->P2SIZ R5:+2 ...skip P3 R3:=REGVFLG&07FC0; SET R3,13; R3->SVRFLG RL0:=10 repeat RLC R3; if WRe0) OUTRe} := { SVREG DECRSP REQRDEF SVREG OUTLDRW} { PSHREGE EXTSGN OUTOPMD SVREGE SVREG OUTLDRW / PSHREGE { EXTSGN} OUTOPMD} ? ; EXTSGN := SVREGE .OUT("WB10A"WRe4) ; PSHREGE := OPUSH ; POPREGE := VARTYP) ; REGVAR0 := "register" ; REGVLST := .DO(RL0:->REGVSC) $( REGVDEF) ; REGVDEF := Del .SAV(*) Del ":" Del .DO(RHXCOMS) LABLReZ ; SELECTST := XCOMS { .OUT("J08"Xc Pp Xc)} LABLReZ ; SELCTST0 := XCOMS $(Del "or" .OUT("J06"#1) Del ) SVLAB .OUT("J0E"Pp) Del ":" .OUT("L"#1) Zp ZINSTP Del ?";" ; NOTENDC := "end" .DO(JP NOGOOD) / .DOLG,3;SET PARMFLG,3)) ? ; IPARM := DECSP_N { STACCaSPD DECRSP} .DO(PARMCNT:+2;R0==R0) ; EXPR_P := .DO(PUSHL PARMDTA) INITXST .DO(if BIT PARMFLG,3 not zero then SETB ASNFLG,XDEFB) EXPRA .DO(POPL PARMDTA) ; ACCtoREG := ?( SVASPEC LDRE carry then R4:+2 ...go past saved regs. on stack until RL0:-1; R4:+2; if NONSEGMD() not then R4:+2 ...go past ret addr repeat SETPVAL() until R6=0; ...other input param offsets->sym table R5:=^PVARTAB+4+NINPARM if R6:=NPARMS-NINPARM-4>>zero then bGNOTDF> OPOP ; OUTOPMD := .DO(PUSH ACCVAL;ACCREG:-1) OUTOP1 .DO(POP ACCVAL) ; OUTSTOR := GETMODE (.DO(RL0==080)) ?( { OUTST1 / OUTOP2} / Ig4P) := (.DO(RL0==0)) OUTOP2 := (.DO(RL0==010)) IgSAV0 OUTOP2 POSTINC := (.DO(RL0==011)) IgSAV 3:=RL0;RL3:=RL1) MRKRVFLG SAVKW DEFINE .DO(RL0:=REGT) SETTYP .DO(RL0:=REGVSC) SETSCP ; ...FUNCBEG := .DO(RETADR:=0FFFF;R3:=WRD*0100+13) OPUSH PSHPARMS .DO(R3:=LOCSPC+PO1SIZ) DECSP .OUT("HA1FD") ; FUNCBEG := .DO(RETADR:=0FFFF) PSHPREGS .DO(R3:=LOCSPC+PO1S(R0==R0) ; SELECT0 := .DO(PUSH ACCVAL) {BEGEND / SETSTACC RELOPD} .DO(POP ACCVAL) ; ZINSTP := XCOMS .DO(PUSH ACCVAL) ZINST .DO(POP ACCVAL) ; IFINST := .DO(ACCVAL:=0FFFF) ZINST .DO(if ACCVAL=0FFFF then SETSTDEFW()); SETSTACC := INITRSP .DO(R3:=ACCVAL) PSHREG) ; STACCaSPD := .SAV(2E) GETSTKLVL .DO(R3:+PARMCNT;if CKB() then R3:+1) SAVNN .SAV(0F) SVWB .SAV(21) STORREG ; DECSP_N := .DO(BIT PARMFLG,0;COMFLG Z) := .DO(SET PARMFLG,0) POPRS SVLAB {.DO(RL0:=8) NPARMLE / .DO(SET PARMFLG,1) .OUT("H030F")} .OUT("A2"Pegin repeat SETPVAL() until R6=0; ...output param offsets->sym table end RET SETPVAL: ...offset of param->symbol table; ret. R1=parm size ...enter with and update: R4=offset, R5=^->PVARTAB, R6=remaining cnt. R1:=0 if R6<>0 then begin R13:=@R5'0 OUTOP2 POSTDEC := (.DO(RL0==021)) ( OUTOPIX0 / Ig .SAV(32) OUTLD3 ?(Ig)) := OUTOPIX0 := OUTOP3 ; ...OUTST2 OUTRe ; OUTST1 := SVREG .OUT("W2000"WRe4 WRe8 WRe8 WRe0 Ig) ; ...OUTST2 := OUTOP2 ; ...SVREG .OUT("W2E00"W0884) ; POSTIZ+PO2SIZ) DECSP .OUT("HA1FD") ; FUNCEND := (.DO(BIT RETADR,0)) SVLAB .OUT("D".DO(R3:=RUNSEG) HLout .DO(R3:=RETADR) HLout Pp,"J08"Re) Zp := .DO(RETADR:=NCODE;if PO1SIZ<>0 then OPOP(R3:=DEFRW2);if PO2SIZ<>0 then OPOP(R3:=DEFRWX)) .DO(R3:=LOCSPC+P1SIZ+P2S...XMETA: *ZAP Test Del Icopy Copyin Copy Outset Out OutN Sav SavB Gen Zp Err0 *ZAP Re Xc WRe0 WRe4 WRe8 Test: JP TEST Del: JP DEL Icopy: JP ICOPY Copyin: JP COPYIN Copy: JP COPY Outset: JP OUTSET Out: JP OUT OutN: JP OUTN Sav: JP SAV SavB: JP SAVB Gen: Jp Xc) ; ...PARAMS := SETSTDEFW .DO(PUSHL PARMDTA) INSTLIST .DO(POPL PARMDTA) ... "," ACCtoREG .DO(R7:-1) ... $(Del "," { .DO(RET) / (.DO(BIT PARMFLG,4;SET PARMFLG,4)) IPARM2 / IPARM}) ; ...OPARMS := Del "->" .DO(SET PARMFLG,5) {.DO(RL0:=1) NPARML GETTYP() R3:=R4; R1:=2 if CKBASBT() then R3:+1 SETVAL(R3) R4:+2 ...presently no long params. R6:-2 end RET PSHPREGS: ...put on stack R13+any local reg. variables>R5+parms 1,2,3 if any R3:=SVRFLG ...contains bits set for local reg. INC : RL0:=029; JR POSTINCD POSTDEC : RL0:=02B ...fall thru: POSTINCD := SavB {.DO(NONSEGMD();RL0:=SRC) / .DO(RL0:+1)} SavB .DO(RL0:=WB) SavB OW8_048 ; SVIMM := SAVNN .SAV(0) ; SVCURT := .SAV(0) / .SAV(1) / SVXTYP ; REGNOTDF: ...test if ACCIZ+P3SIZ) INCSP .DO(R3:=SVRFLG) RESRRS .OUT("H9E08") ; ZAPS := .DO(RESB RTYPFLG,1;MAPBEG:=0;MAPEND:=0FFFF;MAPCMP:=LOCALSC*SCSHFT;MAPMSK:=3*SCSHFT) ZAPASUB ; PVARSUB: ...put id in symbol table, addr of entry->PVARTAB Lkup(W.LASTDE); JP Z,RDFERR R3:=PVARCP GEN Zp: JP ZP Err0: JP ERR0 ITEM1 := .OUT("CTest") SREND := "<" ">" := "[" .OUT("CLatch") SVA2ST OUTRE "]" := "(" ORCL ")" ; ORCL := ANDCL SVLAB $("/" .OUT("J06"Pp) ANDCL) LABLReZ ; ITEM2 := XCOMS .OUT("CErr0") := OUE / DECSP_N} ; ...IPARM2 := ?( {.DO(GETSTKLVL()==0) / .DO(PUSH ACCVAL) DECRSP RESREG .DO(POP R3) REQRX}) ; ...IPARM := DECSP_N { STACCaSPD DECRSP} .DO(PARMCNT:+2;R0==R0) ; ...EXPR_P := (.DO(PUSHL PARMDTA) EXPR .DO(POPL PARMDTA)) ACCtoREG ; variables+R13 if P1SIZ<>0 then begin SET R3,3 if P2SIZ<>0 then begin SET R3,5 if P3SIZ<>0 then SET R3,1 end end SVRRS(R3); RET ...PSHPARMS: ...push 2nd param. (if any), followed by 1st param. (if any) ... ...round up P1SIZ,P2SIZ if=1 not a default; ret. R3=reg. to save DEFRWB(); R3:=ACCVAL repeat if R3=@R5 then begin RESFLG Z; RET end; R5:+2 until R1:-1; RES R3,0; R0==R0; RET FNDAHD: ...chk if id between LASTDE & NEXTDE ahead in expr PUSH R7; PUSHL RR8 R9:=NEXTDE-(R8:=LASTDE) wNT==MAXNPVAR*2-1; RET UGT R13:->PVARTAB[R3]; PVARCNT:+2 SETTYP(RL0:=VARTYP); SETSCP(RL0:=LOCALSC) R0==R0; RET MRKRVFLG: ...set bit in REGVFLG according to reg. with value RL1, type RL0 ...preserve R3 R5:=REGVFLG; RH1:=0 case RL0: of 'B': RESB RL1TPT ; OUTPT := XCOMS ".OUT(" := ".SAV(" { .DO(PUSH R3) .OUT("HC8") .DO(POP R3) OUTHRL Out .OUT("CSavB") / OUTBEG $ .OUT("CSav")} ")" := DOTDO := "{" ORCL "}" := PROCITEM / TRUEITEM ; TRUEITEM := "$" .OUT("L"#1) .OUT("J0...ACCtoREG := ?( SVASPEC LDREG) ; ...STACCaSPD := .SAV(2E) GETSTKLVL .DO(if R3<>0 then SET PARMFLG,6;R3:+PARMCNT;if CKB() then R3:+1) SAVNN ... .SAV(0F) SVWB .SAV(21) STORREG ; ...DECSP_N := .DO(BIT PARMFLG,0;COMFLG Z) ... := .DO(SET PARMFLG,0)  ... ...register P1SZ:R4 P2SZ:R2 P1:R5 P2:R3 ... R5:=DEFRW; R3:=DEFRW2 ... R4:=P1SIZ; R2:=P2SIZ ... R4:+1; RES R4,0; R4:->P1SIZ ... R2:+1; RES R2,0; R2:->P2SIZ ... PUSHL RR4; PSHP(); POPL RR2 ...PSHP~ R2==0; RET Z ... EQVRW(R3); OPUSH(); RET ...NPARMLE: .hile RL0:=@R7<>';' and RL0<>',' do begin if RL0='.' then begin COMM(); JR Z,FNDAHX end PASSQT(RL0:=@R7); JR Z,FNDAHX ...if @CR if IdLN() then begin ...RL0=len, R3 at end LDL RR4,RR8 if RL0=RL5 then begin CPSIRB @R7,@R4,R5,NE; JR NZ,FND,3 'L': begin SET R5,R1; R1:+1 end 'Q': begin RH0:=3; repeat SET R5,R1; R1:+1 until RH0:-1; end end SET R5,R1; R5:->REGVFLG RET SETVALS: ...enter with PVARTAB containing addrs of symbol table entries for ... parameters & local variables, params.6"#1) Zp .OUT("H8A00") := "?" .OUT("H8A00") ; PROCITEM := .OUT("C" *) ; OUTP1 := .DO(PUSH R7) .DO(PUSH R3) .OUT("COutN") .DO(POP R3;RL1:=RL3;RH1:=0;SRLB RL3) .OUT("H" .DO(if BITB RL3,0 zero then Outhex(RL0:=0);Outhex(RL0:=RL3);POP SVLAB {.DO(RL0:=8) NPARMLE / .DO(SET PARMFLG,1) .OUT("H030F")} .OUT("A2"Pp Xc) ; STPARMS := .DO(BIT PARMFLG,5) := SETSTDEFW REQR STOR_P ?( SETSTDEFW .DO(SETB ASNFLG,XDEFB) REQR STOR_P $( .DO(PARMCNT:+2) SETSTDEFW REQR OPOP STOR_P)) ; STO..ret. Z=1 if #parms.<=RL0 (count #","s before ")") ... PUSH R7 ... R7:->R5; RL0:->RH6; RL6:=0 ... while RL0:=@R5<>')' do begin ... case RL0: of '(': GOTIL(RL1:=')') ... '"': SKGOTIL(RL1:='"') ... ''': SKGOTIL(RL1:=''') ... ',': begin RL6:+1; RL6=AHX end R7:=R3-1 end R7:+1 end FNDAHX~ COMFLG Z; POPL RR8; POP R7; RET PASSTUF: if RL0='(' then GOTIL(RH0:=')') else if RL0='[' then GOTIL(RH0:=']') else begin PASSQT: if RL0='"' or RL0=''' then SKGOTIL(RH0:=RL0) end endi 1st ... NPARMS=2*no. params (input & output) ... PVARCNT=2*(no. params + no. locals) ... NINPARM=2*(no. input params) ... bits of REGVFLG denotes local reg vars. ...assign value for each entry & store in table ...am't of space used for local storage R3;R3:+2;LDIRB @R7,@R3,R1)) (")" / .DO(R7:+1) OUTP1) := .DO(POP R7) OUTBEG OUTP2 ; OUTP2 := $ .OUT("COut") (")" / "," OUTP1) ; OUTBEG := .OUT("CIcopy") SREND / .OUT("COutset") ; OUTITEM := Del """ OUTSTR := "*" .OUT("CCopyin") := "#1"..IMAGE: <-------------------> (length IMGSZ=total of code lengths in SECTAB) ...HDRFLG: bit 0=1 =>reloc. info + symtab stripped (execution addr fixed) ... bit 1=1 =>stripped plus may run in any segment ...RELOC: long ADDR; word FLAG ... ...bit FLA ߻p3K6 x  ` /  ҩpB`a4o4"n:`9`:n>[p q ph> t Ѝa6D`:n9|`.n:n9K po6Y`9(`:B9n:n9О YP==0; RET NZ XTYP:=BYT; if WB=1 then XTYP:=WRD; RET WTOXTYP: XTYP:=WRD; RET BTOXTYP: XTYP:=BYT; RET WBEQEVL: RL0:=WB; RH0:=EVL; if RL0=0 then begin RH0==BYT; RET end RH0==WRD; RET W_EVLB: TYPGTEVL~ RH0:=BYT; if WB<>0 then RH0:=WRD if RH0>EVL then R0==dL-RF GType 'X' to reenter\nT0}2?}:NU40140aK`[ PKaPo.[ n[aP .[ `:`;``!4MZ .OUT("CGen") := PROCITEM := DOTDO ; DOTDO := ".DO(" $(Del Del {";"}) ")" ; OUTSTR := Sr .OUT("CCopy") SREND ; CHKHSr := ""H" .DO(Hexd();RET NZ;PUSH R7;Sr();R7:+1;POP R1;RL3:=RL7-RL1;RL0:=@R7==')';RET Z;RL0==',') ; ...CHKHSr checks for '"H[striG,15=0 =>local symbol: bit 0=0 =>code ref, 1=>data ref ... ... =1 =>external symbol: bit 12=1 =>init'n ref ... ... bits 0-11 = symtab ordinal ... repeat entries until RELOCSZ ...SYMTAB: long ADDR; byte TYPE; byte NAME[SHORTNM] ... Tao1q1psa1qsos9p0aCC qp x  0.8poB.9Ѧ1tѫ! 4Cs 1a0 xp p 00`x4 x󠁩pp x 80PIP A:=B:EE PIP A:=B:EE.M PIP A:=B:ZED1 PIP A:=B:ZED2 PIP A:=B:ZED22 PIP A:=B:ZED3 PIP A:=B:RJ.S PIP A:=B:RJ.X PIP A:=B:EEX.M PIP A:=B:HIST  MZ DMZaZ 8iZ ``L ANDCL := $ ?( {NO_MORE / .OUT("J0E"#1) $ .OUT("L"#1) Zp}) ; NO_MORE := XCOMS .DO(RL0:=@R7==';';RET Z;RL0=='/';RET Z;RL0==')';RET Z;RL0==':';RET NZ;R7:+1;RL0:=@R7~=='=') ; QRULE := ANDCL $((":=" / "/"YPE=0 =>undefined, 1=>absolute, 2=>proc, 3=>init'd data, ... 4=uninit'd data ... if name length>SHORTNM, 1st byte=length|080, name follows, 0 padded ... to whole entry ... repeat entries until SYMTABSZ L0~ ORG 0F980 ...Y goes to F940 ...Symbol`;J!: 8J8(0n;ս`;!: 8*0`n;ΞL;`8J:)LVqa4 G`9B:nYELY jYj8`. L9!\r$4h:L:a4Kpыo4L9L>ӯ` >n :L:j:$L;L: BDOT if CKXTYPB() then begin CKEVLB(); RET NZ; DOTSTATE==BYT; RET UGT; R0==R0; RET end BDOT(); RET NONSEGMD: SEGMD==0; RET WREGNZ: ...chk if item on STACK=word reg.<>R0 RD1ST(); RL0==080; RET NZ; RDNXT(); RL0:-1; RET NZ RDNXT(); RL0==0; COMFLG Z; !5U 1 1&70P!P!@ 0 26c+7"aCs!YcACcaq!BؓcA W !duuaK!zCs ް !! !`B%C8) .OUT("H9E06") ANDCL) .OUT("H9E08") ";" ; *ZAPALL R=^Test,^NO_MORE *PACKALL Test: PROC at TEST Del: PROC at DEL Icopy: PROC at ICOPY Copyin: PROC at COPYIN Copy: PROC at COPY Outset: PROC at OUTSET Out: PROC at OUT OutN: PROC at OUTN Sav: PROC at SAV Sas from Y: IN_RL~ EQU 0200 DATA1~ ADDR 0F000 DATA2~ ADDR 0F000+IN_RL LINKAD~ WORD at EXTADR+4 RUNSEG~ WORD at NCDSEG-2 SYMENTSZ~ EQU 14 ...len. of symtab entry SHORTNM~ EQU 9 SYMVAL~ EQU 0 SYMTYP~ EQU 4 SYMNAME~ EQU 5 SGENTSZ~ EQU 8 ...12 SGADDR~ EQU 0 S+L;`8n:3` ;DJ `:J8h:n ;F`;L:j:`n;YLNapKLL;j>I!0R!7n1!AP.80 .80.80a!AQ8 Q0!ͽP!@ m8ԡ9"! !ν!Bء1 > MaСe!B *`'"vB: PROC at SAVB Gen: PROC at GEN Zp: PROC at ZP Err0: PROC at ERR0 Re: PROC at RE Xc: PROC at XC WRe0: PROC at WRE0 WRe4: PROC at WRE4 WRe8: PROC at WRE8 /GLOBAL Err0 Errm Quit Getcon Putcon Outmsg Getrec /GLOBAL Test Id Del Icopy Copy Copyin Hexd Digit GSZ~ EQU 4 SGTYP~ EQU 6 ...8 RELOENTSZ~ EQU 6 RELOTYP~ EQU 4 HDRSZ~ EQU 24 HEADER~ DEFS HDRSZ MAGIC~ WORD at HEADER CODESZ~ LONG at HEADER+2 BSSSZ~ WORD at HEADER+6 SEGTBSZ~ WORD at HEADER+10 HDRFLG~ WORD at HEADER+16 RELOCSZ~ WORD at HEADER+18 SYMSZ~ WOa6ֈ Jߠ ֗  L .OUT("CErr0") := OU RD at HEADER+20 SEGTAB~ ADDR DATA1 UTAB~ ADDR DATA2 UTABPTR~ WORD 0 ...^ next UTAB entry, then marks end of table UTABPTR2~ WORD 0 LU~ BYTE 0 BYTE 0 ...section (allocation) table: ...each entry is for all code/data (separate) in 1 Z8000 seg. MAXNSECS 40 8  s01p x xp   x` ;!0 8  Lݐ`>J.` .n >'{)҂!` 8J .LVh8ҏкґݞ __a4o4L9as`9=0; SavB(); RET SVREGWB: SVREG() ...cont: SVWB: RL0:=0; if ACCTYP=WRD then RL0:=1; SavB(); RET SVREG: SavB(RL0:=ACCREG); RET SVREGE: SavB(RL0:=ACCREG; RESB RL0,0); RET SVRWB: PUSH R3; SavB(RL0:=RL3); POP R3 RL0:=0; if RH3=WRD then RL0:=1; SavB(); RET CK~ EQU 6 NSECS~ WORD 0 SEG0~ BYTE ARRAY 0[MAXNSECS] ...orig. seg. of section SECTYP~ BYTE ARRAY 0[MAXNSECS] ADRLO~ WORD ARRAY 0[MAXNSECS] ADRHI~ WORD ARRAY 0[MAXNSECS] NEWSEG~ BYTE ARRAY 0[MAXNSECS] ...new seg. (ncode) of section SECOFF~ WORD ARRAY 0[MAXN.=7 h9!p t ɀȀW[  Lp x  `xw`>  x 11D 226 33'anaL;n x OO)Ӭa6cn ;ә`. !: 8J.5R4 then begin CKFREE(R3:=@R5); if not zero then PUSHR() end POPL RR4; R5:+2 end POP R3 CKFREE(); if not zero then PUSHR() POP R7 R15:-(R1:=^ENDRSTK-^XSTATE)->R5 R3:=^n8LV x  nVҲ!S!V` 9J  ҷxt!30 w!\`!\oBs%߈p!^$!$(aB 8  0 ;;oBnAy aB0oB 5 w!\zy_ $ " VAR: CKWD(); RET Z; CKBT(); RET Z; CKBASWD(); RET Z; CKBASBT(); RET CKBASD: CKBASWD(); RET Z; CKBASBT(); RET CKBTS: CKBT(); RET Z; CKBASBT(); RET CKBT: RL0==BYTET; RET CKWD: RL0==WORDT; RET CKBASBT: RL0==BASBYTT; RET CKBASWD: RL0==BASWRDT; RET CKP: RL0==PRZZP<^ ^ ^ ^h^ OE \(0ՒLN qXp qp`>Jn9թݞs! 10 8 5 p!Zo6ӓRCn ;_ x OOILNԸ!,0oF3p x nnNnI ** NNp!Ԣ1nIoD!H.8XSTATE; LDIRB @R5,@R3,R1 ...save state CALL PROC2 ...load args., do CALL R5:=^XSTATE; R1:=(^ENDRSTK-^XSTATE)/2 LDIR @R5,@R15,R1 ...restore state R0==R0; RET ...DEFRWB: CKEVLB(); R5:=^DEFRB; RET Z; R5:=^DEFRW; RET DEFRWB~ ...ret. R5=^default regs. f  w>`AaB.?7poBL9f_1 _$J#   aB 5 \  `` 904!^    XX!$!>)CLNa 00oBa00ӬRa+̞6 {p {u  ! `.kOCT; RET CKALAB: RL0==LABLT; RET Z; RL0==ADDRT; RET CKEQU: RL0==EQUT; RET CKUNDEF: RL0==0FF; RET CKBARRY: RL0==BARRAYT; RET CKWARRY: RL0==WARRAYT; RET CKB: ACCTYP==BYT; RET CKW: ACCTYP==WRD; RET CKEVN: BITB ACCREG,0; RET ASNOP: BITB ASNFLG,ASNOPB; COMFLG Z`̈́.8F q3!"mLJLML9aF 8BnLaCsӞ! 9 8  ILLH**LK 80.xp!q-` LSsַMDaF 80 8.xpLINNo6MDLHnKnJ 8.xLor evl., R1=cnt of regs. if begin CKEVLB(); R5:=^DEFRW end then R5:=^DEFRB R1:=2; BITB ASNFLG,XDEFB; RET Z; R5:-2; R1:+1; RET EQVRW~ ...get equivalent word reg. for reg. in R3 if RH3=BYT then RESB RL3,3; RH3:=WRD; RET REQR0~ ...if reg. specified & not;,<>=* !! ~~ ! TE x  p x     ;;C x   ,,   ;;Cp00 99ݞ x 00 99 p 0 Ҟ 4ϗEsބ03s߁3 9; RET FLGBDOT: DOTSTATE:=BYT; RET FLGWDOT: DOTSTATE:=WRD; RET FLGNODOT: DOTSTATE:=0; RET BDOT: DOTSTATE==BYT; RET WDOT: DOTSTATE==WRD; RET NODOT: DOTSTATE==0; RET CKXTYPB: XTYP==BYT; RET ACCR: BITB ACCREG,ADDFLG; RET ACCNOTR: BITB ACCREG,ADDFLG; COMFLG Z; EIRX468271 _ -  ***00@.;KPGWSBMOCLDFQTNJJ|p,pHtJz z468271 _ PFILE TOO BIG NOT ASCIKjKLI** ԱaLMp0kD 11q7$LJ!"`I ** !9LM*0 9 NNLJԞ--From here: --To here^ LNԆaPcode, 1 =>data ... repeat entries until SEGTABSZ .01p3K KQas1L-T:!\.80 5 R-LNLX_$!$їѐL-a4!9.8`: 8 q(0` ;o6p |q xp    ߥJ / x    RET ACCNOTRW: ACCNOTR(); RET Z; CKB(); RET CKASNMT: ASNVAL==0; COMFLG Z; RET ASNNOTACC: CKASNMT(); RET NZ; ASNVAL==ACCVAL; COMFLG Z; RET AASND: CKASNMT(); RET NZ; BITB ASNREG,ADDFLG; COMFLG Z; RET MKXTYP: ...if xtyp not determined, set according to WB XTI NAME? ERROR ERROR NOTFOUND QU N NO ROOMHIT KEYNO CHG ENTER INSERT REPLACE ??? TAG 1 TAG 2 EOF! \!q . ;;   .0 ! $}2?}:]0_   q &! zޡ5aoL+ hNaR@LNooP!bq0hNaP LNKP/!: 8J.(0 DqoT`N q22 jNՄUaP q oR!N*0*0aRoRaP aRױFa4so4a6ssso6Xth R.HL->text RL0:=@R3==0; RET Z; PUT1(RL0:); R3:+1; JR PRT0 NAMEQ: PRT0(^TXNMQ) ...print "NAME?" R7:=^CMDBUF R3:=read(CONLU,R7,LCMDBUF-1)+R7; RL0:=0D->@R3 RET ERROR: ...write "ERROR ##", where "##"=R.A in hex, on current line; ret. Z=0 PUSH R0; PR=SHOWTB TBLUP: if RL1:+1R1 then R3:=R1 end RET FIXEOF: ...make sure EOF proper: 'FF' at eof & CR preceding; also CR before beg if R5:=ENDDAT<>EBUF then begin if B.@R5[-1]FFFE ...make even MGCNO: WORD at EXTHDR EXTADDR: WORD at EXTHDR+2 GETFIL: ...get a file (name at STRBUF) & insert above current line ...enter with R7 at beg. of line ...print errmsg if err; ret. Z=1 if succeed if R3:=open(^STRBUF,0,->RL0)=-1 then begi!ֽ֜LN _םשoDo6aR1KPKRLNړ KPaPoPaRoRaDoDaD1pL;aRLNЋaP< y 11 44 11aPasass5 x EELN{կ_lo6T0(^TXERR1); POP R0; PUTHEX(RL0:) PUT1(RL0:=CR); RESFLG Z; RET SEEK: ...seek to fpos RR4, type R1 of LU R3 SC SC_SEEK; RET GETFLEN: ...ret. RR2=len of file of LU RL3 R15:-6 R5:=R15; R4:=0FFFF; SC SC_FSTAT LDL RR2,R15[2] R15:+6; RET TSTASC: ...testR ...LF ...line feed if RL0:=SHOWCR<>0 then ...if showing CR with another char. if RL1=020) CHRPRT() <>CR then R5:+1 end if R5>=ENDBUF then R5:=ENDBUF-1 R5:->ENDDAT B.EOFCH->@R5; B.CR->@R5[-1]; R5:=EBUF-1; B.CR->@R5 RET ...CRFF: ...make certain 'FF' at EOF & CR preceding; also put CR before beg file ... R3:=ENDDAT; LDB @R3,#EOFCH; R3:-1; LDB @R3,#CRn FILERR(); RET end PUSHL RR6; PUSHL RR8 R8:=R3 GETFLEN(R3); R9:=R3 if R2<>0 then R9:=0FFFF ...fake size that will still overflow R1:=read(R8,^EXTHDR,LEXTHDR,->RL0)==-1; JR Z,CLFERR if R1=LEXTHDR and MGCNO=EEXMAGIC then begin ...chk for special eL;` 9n :_ B x EEpLN x TT\О^H`:n:n9L;w 1p 4s_ LNև|_иaRqCPٗa4KPa6KRo6aPso6aRs o4a6o6aPo4a6s R5 bytes @R3 to see if get non-ascii char before eof char R5==0; RET Z CPB @R3,#EOFX; RET Z CPB @R3,#EOFCH; RET Z BITB @R3,7; RET NZ R3:+1; R5:-1 JR TSTASC READIT: ...read in file with name @FILNM; ret. R3=length, Z=1 iff succeed ...prints error m...print it (note: R.B was set = the char. in ASCPRT) end CR2: CHRPRT(RH1:='~') ...stands for CR in LOCATE cmd. else begin ...if any other kind of char. CHRPRT(RH1:=SHOWCH) ...print SHOWCH in place of actual char. end end ...end o ... R3:=EBUF-1; LDB @R3,#CR; RET PRCBL1: ...print space at col. RL1 of cmd line POSCRS(RL0:=RL1; RH1:=0); PUT1(RL0:=' ') ... RETCRS: RH1:=CRSROW; RL0:=CRSCOL ...ret. cursor to spot in text ... POSCRS: PROC ...position cursor; enter with X-coord. in ditor extension file R6:=EXTADDR read(R8,R6,R9-LEXTHDR,->RL0) RL0==080; JR NZ,CLFERR CALL @R6 ...call to link in RL0:=0D2; JR NZ,CLFERR end else begin ...should be ascii SEEK(R3:=R8; SUBL RR4,RR4; R1:=0) ...seek back to beg. of file o6o6^_ Ğֶa43 q0Vޗu_ _ Ğ 4 1!7_ __2!__ _ _ߒ_ Ğ x AAa43 0`.n:L; o4_ )a430֚_ _ L!<`}`sg. if fails R3:=open(^FILNM,0,->RL0) if RL0=0C7 then begin R3:=0; RET end ...not found ok if RL0<>080 then begin ERROR(); RET end PUSHL RR6; R6:=R3 GETFLEN(R6) ...get file len.->RR2 R7:=R3 if R2<>0 or (ENDBUF-EBUF)R6 ...shift file fwd., R6=1st opened up pos. JR NZ,CLFFAIL R7:=read(R8,R6,R9,->RL0) if RL0<>080 then R7:=0 PUSH R0 ...following moved to ZED22 (done when GETFIL true): ... _ LXpJ q**13LW_ V0LW_ LN!E_ ,! LN!L_ $(0_ _ܠ_  dW!\poB~ x TTn @_ L@ n ?_ L? x UU_ pph-_  NNh-LN(`.__t PRT0(^TOOBIG) ...print "FILE TOO BIG" close(R6) RESFLG Z end else begin read(R6,EBUF,R7,->RL0) ...read in file PUSH R0 close(R6) POP R0 if RL0<>080 then ERROR() else begin if R5:=100>R7 then R5:=R7 if TSTASC(EBUF,R(RL0:=RH1) ...put out char. in RH1 end R7:+1; JR PRTLUP ...go to next char. ASCPRT: ...return Z=1 if R.A>=020 and <07F, else Z=0; R.B=R.A RL0:->RH1==07E; RET UGT ...sets Z=0 if R.A=07F RL0==020; RET C ...sets Z=0 if R.A<020 RL0==RL0; RET ...Z=1 . (directly) to console PUSHL RR0; R1:=1; RH0:=STDOUT; RL0:=WRT PUTGET~ PUSHL RR2; R2:=0FFFF; R3:=R15+5 SYSTM() POPL RR2; POPL RR0; RET ... GET1IF: ...get 1 char. from console if ready (Z=1 if char.; Z=0 if no char.) PUSHL RR0; R1:=0; RH0:=CONLU; RL0:=R6:->BUFPOS; CRSCOL:=0 ...for printing (beg of read-in text) ... RL0:=ROWNO->CRSROW ...adjust cursor row FNDEOF(R6,R7)->R3 ...1st char past valid new data SHFTBK(R7:=R6+R9; R1:=R7-R3) ...shift back file over excess ... R7=1st pos past ope2L,L,__!:_` n .` n /!!)1P SCREEN EDITOR - 11/22/82 ʞdW!\poB~ x TTn @_ L@ n ?_ L? x UU_ pph-_  NNh-LN(`.__ 5) not then begin PRT0(^NOTASC); RESFLG Z end end end R3:=R7 POPL RR6; RET SYSTM: PUSHL RR4; SC 0; POPL RR4; RL0==080; RET FILERR: ...write "ERROR ##" on cmd. line; RL0=error no.; ret. Z=0 RL1:=RL0; BLCMR() if RL1=FNF_ERR then begin PRCMR1(^TX CHRPRT: ...print R.B unless at last col. (R.B saved); inc RL1 RL1:+1==NCOL; RL0:=RH1; if carry then PUT1(); RET BLCMR0: ^TXTBL7; JR PRCMR0_ ...blank rightmost 7 spaces on cmd line HITKEY: ^TXTHTK; JR PRCMR0_ ...print "HIT KEY" on cmd. line ... NOROOM:RD; JR PUTGET GETCINIT: QSEQP:=0; RET GETCHR: GET1: ...get 1 char from std. input save R1..R5 if QSEQP=0 then begin RL0:=getchar() ...getchar reads STDIN if BITB RL0,7 not zero then begin ...test for EOF ...(getchar rets. FFFF on eof or caned-up space; R1=am't to shift ... R3:=R6; R1:=R7 ...R3=beg new part; R1=len read ... RL0:=EOFCH ... if R1<>0 and CPIRB RL0,@R3,R1,EQ zero then R1:+1 ... ...R1=no. bytes read in from 'FF' on ... R1:+R9-R7 ...add diff to orig am't shifted ...  GETTYPE ; IdNOTEQU := .DO(CKEQU();JP Z,NOGOOD;R0==R0) ; ...IdNOTEQALB := .DO(CKALAB();JP Z,NOGOOD;R0==R0) ; VARID := {CKVAR / NOGOOD} ; ...WBID := .DO(CKWB();JP NZ,NOGOOD) ; ...SAVVALI := .DO(GETVAL();PUSH R3) "[NOT); PRCMR0(^TXFND) end else begin PRCMR1(^TXERR2); POSCRS(RL0:=NCOL-7;RH1:=0) PUTHEX(RL0:=RL1) end RETCRS(); RESFLG Z; RET PUTFIL: ...write to file (name at STRBUF) from R3 to R7; Z=0 if fail, else=1 PUSHL RR6; PUSHL RR8 R8:=R3 ... RNDUP(R3:= ^TXTNRM ...print "NO ROOM" on cmd. line, ret. cursor; fall thru: ... PRCMR0_~ PRCMR0: ...enter with R.HL->7-byte string; print top row, right corner ...ret. with HL at BLCMRF, (HL)=1 RL0:=NCOL-7; JR PRCMD7 ... PRCMR1: ...enter with R.HL->7-byte stringn get FF eof char.) QSEQP:=^QUITSEQ JR GETQSEQ end end else begin GETQSEQ~ RL0:=@QSEQP; QSEQP:+1 end restore R1..R5 RET GETCHR1: ...get char. but not EOFX repeat GETCHR() until RL0<>EOFX; RET CLRSCR: PROC ...clear screen RL0:=CLRSCRN SHFTBK(R7:=R6+R9; R1:) ...shift back file over excess ... ... R7=1st pos past opened-up space; R1=am't to shift FIXEOF() ...make sure CR at end before 'FF' POP R0 RL0==080; JR NZ,CLFERR end close(R8) R0==R0; JR GETFILX CLFERR~ FILERR() CL" ( .DO(POP R1;R3:+R1) SVADDR / .DO(POP R3) SAVNN SEGMT ) ... := .DO(POP R3) SVADDR ; SVADDR := SAVNN SEGMT .SAV(0) ; SEGMT := NONSEGMD := {(.DO(RH3==0)) .DO(R0:=RUNSEG;RES R0,15;RH3:=RH0;PUSH R3;Ig();POP R3) SAVNN} / .DO(W.RUNR7-R8+1; R5:=DEFRL)->R10 ...len to write (1 for 'FF'); rnd up if R9:=open(^STRBUF,1,->RL0)<>-1 then begin PUTEOFSQ(R7)->R3 ...put eof seq., save orig chars, R3=past eof seq. R1:=R3-R8 ...len ... RL6:=@R7; LDB @R7,#EOFCH ...put in 'FF' after end,; print top row, 15 cols. from right ...ret. with HL at BLCMRF, (HL)=1 RL0:=NCOL-RTL ...RTL=15 PRCMD7: POSCRS(RL0:; RH1:=0); RH1:=7 repeat PUT1(RL0:=@R3); R3:+1 until RH1:-1 zero; RETCRS() ...return cursor ^BLCMRF; LDB @R3,#1; RET ...flag msg. in r SCRCMD: ...enter with RL0=screen func. code PUSH R0 if BITB RL0,7 not zero and RL0:=LEADIN<>0 then PUT1(RL0:) POP R0; RESB RL0,7 PUT1(RL0:) RET ERASL: PROC ...erase current line SCRCMD(RL0:=CLRLIN); RET INSLIN: ...if can, do insert line, ret. Z=1FFAIL~ close(R8) RESFLG Z GETFILX~ POPL RR8; POPL RR6 RET PRLIN: ...print from R.DE, row ROWNO, col. R.C up thru a CR ...set Z=1 if all printed; Z=0 if got to screen bottom R7->R3; RL0:=CR; R2:=0; CPIRB RL0,@R7,R2,EQ ...find next CR ...R7=char. afteR NZ,EDITX ...read in file (rets. file len) FNDEOF(EBUF,R5)->ENDDAT ...pts. to eof char at end of data FIXEOF() ...make certain an FF at EOF; CR before; + put CR before beg. ...if writing out to .OLD file, do here EFLG:=1 EDIT2: EDIT() ...go edit . saving orig. char. write(R9,R8,R1,->RH6) ... RL6:->@R7 ...replace 'FF' by orig. char. RESEOFCH(R7) ...restore orig chars @eof close(R9,->RL0) if RH6<>080 then RL0:=RH6 end if RL0<>080 then FILERR() ...if fail, print error msg. POPL RR8t. part cmd line BLCMR: BLCMRF==0; RET Z PRCMR1(^TXTBL7); BLCMR0() ...blank all right part cmd line DECB @R3 ...reset BLCMRF marking rt. part cmd line blank RET PRNEW_: ...print from R7, row ROWNO, col. RL1 to end of line ...if end of line on a dif; else ret. Z=0 RL0:=INSLN==0; COMFLG Z; RET NZ SCRCMD(RL0:) R0==R0; RET ...RNDUP: ...round up R3 to mult. of R5 (for now) ... R3:+R5-1&-R5; RET WRTOUT: if R3:=open(^FILNM,1,->RL0)=-1 then begin ERROR(); RET end PUSHL RR6; R6:=R3 PUTEOFSQ(ENDDAT)->Rr CR ...cont: CONOUT: ...print to console from HL to DE, but not past bottom of screen ...start at row=ROWNO, col.=R.C ...return Z=0 if got to scr. bottom before done, else Z=1 R3<->R7; PUSH R3 ...save last char. to print POSCRS(RH1:=ROWNO; RL0:=RL1).. CLSCMF() ...close cmd. file if one if DUNFLG=1 then begin ...if DUNFLG=2, don't write out file WRTOUT() ...write out edited file if not zero then ?"Type 'X' to reenter" end EDITX: LDL RR4,SYSSP; R3:=flag; SET R3,15; R3->flag /SEG LDL RR14,RR; POPL RR6; RET PUTEOFSQ: ...enter R3=^place to put eof seq. ...save orig. chars; put seq., ret. R3 past R1:=R3 R5:=^SAVCHBF; R0:=3; LDIRB @R5,@R1,R0 RL0:=EOFX->@R3' if CKINBUF() @R3' RL0:=EOFCH->@R3' end RET CKINBUf. row from prev. (as given by CRROW0), print ... till screen full & update CRROW0 ...R7==ENDDAT; JR Z,PRFIN RH1:=CRROW0; PUSH R1; PUSH R7 FNDCRR(); POP R7; POP R1 ...get new CRROW0; RH1=old CRROW0; RL1=orig. RL1 if RL6:=CRROW0-RH1>zero then begin 3 ...put eof seq., move R3 past R1:=R3-EBUF ... RNDUP(R3:-EBUF; R5:=DEFRL)->R1 write(R6,EBUF,R1,->RL7) RESEOFCH(ENDDAT) close(R6,->RL0) if RL7<>080 then RL0:=RL7 if RL0<>080 then ERROR() POPL RR6; RET PRT0: ...print out msg. until byte 0; enter wi ...pos. cursor to start PRTLUP: POP R3; R3==R7; RET Z ...test if done PUSH R3 ...save last print char. if RL1=0 then ERASL() ...if in 1st col., erase line while RL0:=@R7=0 do R7:+1 ...go past nulls case RL0: of TAB:begin ...if tab RH1:4; RET /NONSEG FNDEOF: ...enter with R3=^text, R5=len to look for eof char. ...ret. R3=^char or after all if none ...for now, checks for both 1A & FF if R5<>0 then begin ...R5=file len. PUSH R3; PUSH R5 RL0:=EOFCH; CPIRB RL0,@R3,R5,EQ if zeroF: R1:=ENDBUF-1; R3==R1; RET ...preserve R3,R5 RESEOFCH: ...restore @R3 chars. saved in SAVCHBF R5:=^SAVCHBF; LDIB @R3,@R5,R1 if CKINBUF() LROW then begin CRROW0:=LROW; JR PRSCR end POSCRS(RL0:=0) ...pos. cursor at old CRROW0+1 repeat ...do CRROW0-old CRROW0 insert lines if can, else print scr. if INSLIN() not zero then begin RETCdif FILCL3: until begin GETCHR(); RL0:->RL7==CR end or RL0=ESC; ...get new char. until CR or esc. W.CBUFPS; LDB @R3,#CR ...put in CR PRCBL1(); RL7==ESC; RET ...blank out "_"; Z=1 if last char.=escape CKCMDT: ...chk if cmd. R.A in table @HL (if R.A=re seg/nonseg mode := "return" {"(" INSTLIST ")"} FUNCEND := "calx" Del .OUT("H7F14","AL"*) ...call external := "patch" .DO(R6:=03) {"r" .DO(RH6:=1)} { .DO(RL6:=2)} .DO(PUSH R6) .DO(RES R3,0;LDL RR4,RR2;POP R6) {"[" ing to 1st char. (R.DE pts. to 2nd char.) RL0==ESC; RET Z ...ret. if escape RL0:->RL7 ...save 1st char. CHKCMD(RL0:); RET NZ ...check if char. valid; print "???" if not ^CMDBUF->R3; RH7:=0 ...init. pos. in cmd. buffer RL0:=NCOL-(RTL+2) ...last coRET Z RL0==','; RET Z if RL0=CR or RL0=';' then begin RESFLG Z; RET end R7:+1; JR FNDSPC PUTHEX: ...R.A converted to hex & the 2 hex chars. put out PUSH R0; RL0:/16; HBTHEX(); POP R0 HBTHEX: if RL0:&0F+'0'>'9' then RL0:+7 PUT1(RL0:); RET DIGIT: ...tRS(); JR PRSCR end ...fix LSTROW, EOFFLG: if LSTROW=LROW then EOFFLG:=0 else LSTROW:+1 until RL6:-1 zero; RETCRS() PRNEWL: PRLIN() RETCRS(); RET end JR Z,PRNEWL JR PRSCR PRSCRB: PRTB() ...print rem. screen starting beg. curr.lower case, made upper) if RL0>=060 then RESB RL0,5 RL1:=@R3; RH1:=0; R3+1; CPIRB RL0,@R3,R1,EQ; RET CHKCMD: ...chk if R.A=valid cmd. starting char. for on cmd. line CKCMDT(^CMDTB2); RET Z ...chk list of reg. cmd. line cmds. if RL0<>CR and RL0<>'X' t(.DO(if RL0:&0F>=RL6 then RL0:->RL6==RL0)) "]"} Patchsub ; INSCNT : R3:=R7-(^BUFF+2); LDB BUFF+1,RL3; RET WDATA := Del .SAV(Re *) .DO(R7:+1==R7) := { .SAV(Re"%B") / .SAV(Re"%W")} ; PRTBEG := .OUT("H7F46") .DO(NARG:=0) ; PRTl. in cmd. line buffer (leaving 1 for CR) FILCL2(); RET Z ...fill buffer; ret. if not to execute XEQCML: ...execute cmds. on cmd. line ^CMDBUF XCMLLP: R3->W.CBUFPS; R3<->R7 ...DE=pos. in cmd. buffer (for parsing) TONOSP() ...go past spaces; ret. RL0=est for an ascii digit @DE (returned in R.A); if so, Z=1, DE=DE+1 RL0:=@R7=='0'; RET ULT; RL0=='9'; RET UGT R7:+1; RL0==RL0; RET NUMBER: ...chk if a number @R7 ...enter with a digit in RL0 ...get more digits from @R7 (incrementing R7) as long as there line PRSCRC: RL1:=0 ...R7 must be at beg. of a row, sets col=0 JR PRSCR ... CRROW0:=0 ...to assure printing full screen ...PRNEW: ...print from R.DE, row ROWNO, col. R.C to end of line ...if end of line on a diff. row from prev., print till screen ..hen begin CKCMDT(^CMDTBC); RET Z ...chk cursor move cmds. (not CR or 'X') end QSTION: PRCMR0(^TXTQST); RESFLG Z; RET ...print "???" on right part cmd. line; Z=0 EXTN: ...do extension TAGFLG==0; JR NZ,QSTION ...must not be tags present R3:=EEX0;SECS] ...offset from orig. to new addr in seg. NSEGS~ EQU 4 ...no. segments on Z8000 SYSSEG~ EQU 0 ...seg. with system BUFSEG~ EQU 3 ...seg. with buffer pool FREELO~ WORD ARRAY 0[NSEGS] ...lowest addr free in seg. FREEHI~ WORD ARRAY 0[NSEGS] ...highchar CHKCMD(RL0:); RET NZ ...check if valid char. @DE R7:+1 ...pt. to 2nd char. of cmd. CMD(RL0:; ^CMDTB2) ...go to routine according to 1st char. ^CMDTBC if not zero then CMD() ...possibly cursor move or mode enter cmd. W.CBUFPS ...char. starti are more ...calculate value of number, return in R3; set Z=1 if true DIGIT(); RET NZ R3:=0 repeat RL0:&0F->RL1; RH1:=0; R3:*10+R1 until DIGIT() not zero; R0==R0; RET LOCSTR: ...enter with R7->pos. in text; R3->DEFT 'STR'; R5=no. bytes to search . full & update CRROW0 ... CPB @R7,#EOFCH; JR Z,PRFIN ...if at EOF ... PRLIN() ...print till CR ... ^CRROW0->R3 ... if not zero then begin ...Z=0 means line went to scr. bottom ... RL0:=LROW->@R3; JR PRFIN ...save last print line info ... end ... if  BIT R3,0; JR NZ,QSTION ...chk if EEX defined CALL @R3; R7:->CBUFPS ...call EEX if defined to parse cmd. JR NZ,QSTION ...no valid cmd. FNDPOS() ...pos. in buffer->DE R3:=ECODE0 if BIT R3,0 zero then CALL @R3 ...go to ECODE if defined to do cmd. est addr free YOFFSET~ WORD 0 ...gets RUNSEG-NCDSEG HIESTSEG~ LONG ...get highest new addr for new NCODE WORD 0 HIOFF~ WORD 0 ENDDAT~ WORD 0 SYMPTR~ WORD 0 NXTSYMP~ WORD 0 SYMCNT~ WORD 0 ......................... /NONSEG MRKUSDSP~ ...mark memorng or at end of string in prev. cmd. repeat RL0:=@R3==CR; RET Z; R3:+1 until RL0=';' ...find end of prev. cmd. ...if another cmd follows, HL->first char., else ret. JR XCMLLP FILCL2: ...enter with HL=start of cmd. buffer; R.E=1st char. ... R.D= ...if R5>space in buffer, just search to end of buffer ...ret. R3 same; if string found, R7->1st char., Z=1 ...if not found, R7->after last char. searched, Z=0 CHKIN(); RET NZ ...chk if R7 in text in buffer TESTB @R3; RET Z ...str. len=0 PUSH R3; ARL0:=ROWNO-1=@R3 then begin RETCRS(); RET end ... ...check if CR on same row as prev. ... RL0:->@R3; JR PRSCR ...update CRROW0; print rest of screen ... PRSCR0: ...do PRSCRF + pos. cursor at home pos. CRSHM(); JR PRSCRF PRSCRH: ...do PRSCRN + cursor hFIXEOF() ...make sure 'FF' at EOF, CR before, & CR before beg. of text if CHKIN() not zero then R7:=ENDDAT ...make sure DE in buffer LOCPRT() ...if char. at DE off screen, print so in middle if zero then PRSCRN() ...else reprint screen NULL: RET ..y space already used in FREELO[SEG],FREEHI[SEG] ...configuration dep. save R6,R7 R3:=flag; SET R3,15; R3:->flag /SEG LDAR RR6,$ R3:=flag; RES R3,15; R3:->flag /NONSEG RL6:=RH6; R6:&07F ...Y seg. R7:=NCDSEG; RL7:=RH7; R7:&07F R1:=0 repeat 0->FRstarting col. for cmd. line; R.A=last cmd. line col. ...fill cmd. buffer, at same time printing out on cmd. line ...return Z=1 if to abort without executing, else Z=0 R3->W.CBUFPS; RL0:->LCMCOL; RL1:=RH7 repeat if RL0:=RL7=BKSP then begin ...if bacDJLEN(); POP R3 ...R1=min(R5,dist. to EOF) R1==0; COMFLG Z; RET NZ ...if at EOF R3<->R7; CPSIR0(); if zero then R3:-1==R3 ...do search R3<->R7; RET NEWSTR: ...enter with R7->text; R5=no. chars. to delete starting curr. pos. ...(don't del. past ENDDome CRSHM() PRSCRN: ...set DE=BUFP0 before doing PRSCRF R7:=BUFP0 PRSCRF: ...from row 1, print till screen full starting at R7 in buffer ...R7 should be 1st char. in a line ...cursor returned to CRSROW, CRSCOL R7:->BUFP0; ROWNO:=1; RL1:=0 ...BUFP0=1s .null cmd. just rets. GETFNM: ...test if valid filename @R7, incing R7 ...if true, ret. Z=1, put name @R3 followed by 0 TONOSP(); RET NZ ...find next non-space; check not CR or ";" PUSH R6; R6:=R3 if VALIDCHR(B.@R7) then begin PUSH R7 repeat R7EELO[R1]; 0FFFF->FREEHI[R1] if R1FREELO[R1]; 0->FREEHI[R1] end until R1:+1=NSEGS; R3:=05000->FREELO[SYSSEG] ...system below 0.5000 R3:->FREEHI[R6] ...Y above YSEG.5000 if R3:=NCODE>FREELO[R7] then R3:+1&0kspace W.CBUFPS-1->W.CBUFPS; LDB @R3,#CR ...update CBUFPS; store CR there PRCBL1() ...blank out "_" RL1:-1 ...R.C=prev. col. RH7==0; PUSH R7; R7:=^CMDBUF if zero then FNDCOL() ...if doing main cmd buffer, get R.C=col. prev. chAT); R3->DEFT 'STR' to insert at current pos. ...if R3 or @R3=0, don't insert anything ...if R7 not in text, or after deleting, no room to insert, ret. Z=0 ...do, adjusting ENDDAT; ret Z=1, R3 same, R7->after last char inserted CHKIN(); RET NZ ...chk t printed char. PRSCR: ...print starting at R.DE, row ROWNO, col. R.C, till screen full W.ENDDAT; R3<->R7; CONOUT() ...print till screen full or EOF ...note: if CR on last row, R.DE will not be incremented to next char. PRFIN: RH1:=ROWNO->LSTROW ...la:+1 until VALIDCHR(B.@R7) not; POP R1 if R5:=R7-R1>MAXFNML then R5:=MAXFNML LDIRB @R6,@R1,R5 RL3:-RL3->@R6 ...0->@R6, Z=1 end POP R6; RET ...VALIDCHR0: ...test if RL3=valid starting char. for filename ... if RL3>='0' and RL3<='9' or RL3:&0DFFFE->FREELO[R7] ...below NCODE in same seg. assumed used restore R6,R7 RET FILSECTAB~ ...fill section table save R6,R7 NSECS:=0; R7:=^SEGTAB while R7<^SEGTAB+SEGTBSZ do begin LDL RR0,R7[SGADDR] ...addr RESB RH0,7; R3:=@R7[SGTYP]; RL0:=RL3 ar ...note: there should not be any tabs if doing "X" cmd buffer POP R7; POSCRS(RL0:=RL1; RH1:=0) if begin RL1==RH7; RL0:='_' end then RL0:=' ' RH0:=flag; PUSH R0; PUT1(RL0:) ...delete prev. char.; print "_" if <>col. 0 RETCRS() ..if DE in text PUSH R3; PUSH R7 ADJLEN() ...R1=min(R5,dist. to EOF) R7:+R1; SHFTBK() ...delete POP R7; POP R3 R3==0; RET Z; RL1:=@R3==0; RET Z; RH1:=0 ...R1=no. chars. to insert PUSH R1; PUSH R3; PUSH R7; SHFIFR(); POP R7; POP R3; POP R1; RET NZ st printed row (may be "EOF") EOFFLG:=0 ...reset flag if RL0:=@R7=EOFCH then begin ...chk if EOF RL0:->EOFFLG ...set flag POSCRS(RL0:=0) ...make sure of pos. ^TXTEOF; R7:=^TXTEOF+3; RL1:=0; CONOUT() ...print "EOF" BLNKLS(RL1:=ROWNO) ...F>='A' and RL3<='Z' then R0==R0 ... else RESFLG Z ... RET ...VALIDCHR: ...test if RL3=valid char. for filename ... PUSH R3; VALIDCHR0(); POP R3; RET Z ... RL3=='.'; RET Z; RL3=='_'; RET Z ... RL3=='/'; RET Z; RL3==':'; RET INVCHS: DEFM ';,<>=*' LINVCHS:  ...RH0=seg., R1=offset, RL0=type R6:=0 while R6ADRLO[R6] if R3:=R1+@R7[SGSZ]>ADRHI[R6] then R3:->ADRHI[R6] JR FSCTB2 end R6.ret. cursor POP R0; RH0:->flag; RET Z ...ret. if 1st col. end else if RL0<>0 then begin ...ignore null chars. RL3:=RL1 if RL0=TAB then begin RH7==0; JR NZ,FILCL3; TABPOS() end ...get C=col. of next tab pos.-1 (no tab allo ...shift file fwd. PUSH R3 R3:+1; LDIRB @R7,@R3,R1 ...move in new string POP R3; R3==R3; RET CHKIN: ...ret. Z=1 if EBUF<=DE<=ENDDAT; else Z=0; save all regs. R7==ENDDAT; RET UGT R7==EBUF; RET ULT R0==R0; RET ADJLEN: ...ret. R1=min(R5,ENDDAT-R7) blank rem. lines end RETCRS(); RET ...return cursor to prev. pos. BLNKLS: ...erase rem. rows on screen after R.C POSCRS(RL0:=0; RH1:=RL1) while RL1:+1=MAXNSECS then OVFLERR() RH0:->SEG0[R6]; RL0:->SECTYP[R6] R1:->ADRLO[R6]; R1+@R7[SGSZ]->ADRHI[R6] NSECS:+1 FSCTB2~ R7:+SGENTSZ end restore R6,R7 RET OVFLERR~ Errm(); DEFT 'SEGMENT OVERFLOW ' ALOSECS~ ...allocate sectiwed if "X" cmd) if begin RL0:=LCMCOL==RL1; RL1:=RL3 end >=zero then begin ...check if will fit in space on cmd line (not last 15 cols.-1) W.CBUFPS; RL7:->@R3 ...put new char. in cmd. buffer PUSH R7 ...save D R3->R7; R7:+1; R7:->CBUFPS ...R1:=R5 R3:=ENDDAT-R7==R1; RET NC R1:=R3; RET  cols. NROWS: EQU 24 ...no. of rows on screen NCOLS: EQU 80 ...no. of columnE<=ENDDAT; else Z=0; save all regs. R7==ENDDAT; RET UGT R7==EBUF; RET ULT R0==R0; RET ADJLEN: ...ret. R1=min(R5,ENDDAT-R7) om jump table @HL ...if no routine is found returns NZ ...otherwise the selected subroutine is executed returning Z=1 ...jump table structure: ...n CMD1 CMD2 -- CMDn ADDn -- ADD2 ADD1 CKCMDT(); RET NZ ...no routine found R3+R1+R1+R1->R3 ...pt. to se Z=1; R.A=char. @DE RL0:=@R7==' '; RET NZ ...no spaces repeat R7:+1 until RL0:=@R7<>' '; RL0==RL0; RET TONOSP: ...enter with R.DE in cmd. buffer; search for 1st char. not space ...return Z=1 if not CR or ";", else Z=0 (R.DE pts. to char; R.A=char) ons in memory save R6,R7 R6:=0 while R6FREEHI[R1] then begin repeat if R1:+1>=NSEGS then OVFLERR() until R3:=FREEHI[R1]-FREEupdate CBUFPS ROWNO:=0; CONOUT() ...print out new char. (updates R.C) POP R7; PUT1(RL0:='_') ...print out "_" as "cursor" if RL1=1 then CALL TAGSHW_ ...because CONOUT clears line when col=0 RETCRS() ...return cursor end end en5 ^YR^Z^Z^Z^Z^[^\&^\ ^eB^eL^d^e,^Qb^el^e^e^e^e^r BB^ LL^ߓHp 1_rlߘߡ Y|1!_rl+ BB^ LL^߽$rլJ!_rlD 6Մմ\ubroutine addr. R3:=@R3 ...@2HL->R.HL=subroutine addr. ...note: R.A transmitted thru to routine CALL @R3; RL0==RL0; RET ...call subroutine; Z=1; return FILCML: ...fill cmd. line buffer, at same time printing out on cmd. line ...go to routine accordSPC() ...go to 1st char. not space if RL0=CR or RL0=';' then begin RESFLG Z; RET end ...if CR or ";", Z=0 RL0==RL0; RET ...set Z=1 FNDSPC: ...move R.DE to 1st space or "," (put in R.A) ...if CR or ";" found first, ret. Z=0, else Z=1 RL0:=@R7==' ';  LO[R1] >zero and R3>R7; ...">R7" above since may need to add 1 to FREELO end RL1:->NEWSEG[R6] R8:=FREELO[R1] if ADRLO[R6]&1 not zero then R8:+1 ...lo-add of section must be same even/odd R8-ADRLO[R6]->SECOFF[R6] R7:+R8+1&0FFFE->FREELO DEFT 'LINK: READ ERR ' ORG $-2 ERRMCD~ DEFS 2 RDADR~ ...read long word @RR2->RR2 R0:=flag; SET R0,15; R0:->flag /SEG LDL RR2,@RR2; JR RWX /NONSEG ... WRADR~ ...write long word RR2->@RR4 R0:=flag; SET R0,15; R0:->flag /SEG LDL @RR4,RR2 RWX~ RES R0,>g(ok > k}͈(ɯ21:((Ì *."i!N#T]> wh  ͪ !+~|  DM*` "W ( ! >2( ͧ:*=H ̓,̆> <2+( ͽ *d~#bk̓{8>(O ! SVSYM(R7+SYMNAME) if RL6=0 then begin ...if undef'd FNDSYMI(); R6:=SYMCNT/SYMENTSZ XXX: while FNDSYM(R6) do begin ...RR2=addr in UTAB entry PUTNCD() ...^ref OUTLREF() ... .OUT("AL"Pp) end Ig() end else begin ]!v")]Gr> []e^e]Wr*)]e][]e]N#[]́]͘]e]>0{S+][)]S)][+]ͯyo]*+]w#"+]o]og}(%#o]oo]gXxe] ~ N#y( >+>0y${[]ɯ2.]e]>!8{!( (,(( GH L( []:.]=>[R1] RH1:=RL1; RL1:=0; SET R1,15 if R1>=HIESTSEG then begin R1:->HIESTSEG; R7:->HIOFF ...get highest addr for new NCODE end R6:+1 end restore R6,R7 RET LOADIMG~ ...load image save R6..R9 R9:=^SEGTAB while R9<^SEGTAB+SEGTBSZ do begi15; R0:->flag /NONSEG RET /^LINK->LINKAD ...link in ORG L0 .../ZAPALL TMPS /SEG  : bit 12=1 =>init'n ref ... ... RR2,@RR2; JR RWX /NONSEG ... WRADR~ ...write long word RR2->@RR4 R0:=flag; SET R0,15; R0:->flag /SEG LDL @RR4,RR2 RWX~ RES R0,! 7 ( !E yK *BR0 !" PYl (E ( ~ +> +R8!R !7 (Wy(KB͖(ͽ `il (W!ͽ bk ` RDMeW!R ! WF  LDL RR2,R7[SYMVAL] if RL6<>1 then begin ...symtyp 1=abs. (not now used) R5:=0; if RL6=4 then R5:=1 ...symtyp 4=bss (2=proc, 3=idata) XLATADR() end PUTNCD() LABLRe() ... .OUT("L"Re) end SYMCNT:+NXTSYMP-SYMPTR; SYMPT( $ QH2@o\E U9]+0e]${[]o] `o]v  _@o] 9]LD B_/],`o] _o] co] a o] Ϳeo] o]EIRX468271 _ - ]]d+Fn if @R9[SGTYP]=0 then begin LDL RR6,R9[SGADDR] ...addr RESB RH6,7 R8:=-1 repeat R8:+1 until RH6=SEG0[R8] and SECTYP[R8]=0; RH6:=NEWSEG[R8]; RL6:=0 R7:+SECOFF[R8] READA(LDL RR2,RR6; R5:=@R9[SGSZ]) end R9:+STO2() ...put out whole seg. ... POP R3 ...HL pts to next seg. des. in buffer ... end ... CLFPT() ...close file; restore list file LU->vectors ... if RL0<>080 then WRTERR() ... POPL RR6; R0==R0; RET INRELOC: PROC ...enter with RR2=target machine addrѷRͅ 6 ͽ  6#, 06 #6#K B  w#, 0! [K E!f ͏ HIT KEY TO REENTER:!R !7 (5E*",".R"QU N [,*.R #*".!l (*".! *.~( ˿#".!+~=w*,"R:=NXTSYMP end restore R6,R7 RET GETNXTSYM~ ...have SYMPTR @sym_entry or ENDDAT, ENDDAT=end of data, ... SYMCNT=bytes of symtab to here, SYMSZ=total symtab size ...ret. SYMPTR at full entry, NXTSYMP after; poss. update ENDDAT PUSHL RR6 R1:=SYMPTR d+Fi{t5.;KPGWSBMOCLDFQTNJE|:&f3468271 _ K*B (+~# (#KB 8`i+"6+6 *+6 :+®  (yͧ> :6G:7:U:QO˹x ŁG x :S( :R(  :T~ #!0!UT] GENTSZ end restore R6..R9 RET XLATADR~ ...enter with RR2=orig. addr, R5=region; xlate to new pos. (->RR2) save R6,R7 LDL RR0,RR2; RL7:=RL5; RH7:=RH0; RESB RH7,7 R6:=0 while R6T !Uw#6 ͈_:J̗:SĪ{!0@:*([0>!5w:6( |4:7O͖S2B+> ##( A  >O0Ax iyMO oOG*2R O  yP8O>[0S0ʹx<26:62:| !if R1+SYMENTSZ>ENDDAT then begin R5:=GETRDLEN() R5==SYMENTSZ; JR ULT,GETNSX READSYM(^DATA1,R5) R1:=^DATA1->SYMPTR end RL0:=@R1[SYMNAME] R6:=SYMENTSZ if BITB RL0,7 not zero then begin RL6:=RL0&07F+(SYMNAME+1); RH6:=0 R6:=(R6+(SYMENTSZ-w # +R(+ NOT ASCII FILE TOO BIG NAME? ERROR ERRORO!7y͗> O͗!>~>Iͧy͗͠bk> :5GyͧRy ! :<G yP0 x  G:;(yO:;0 GP  ~#yP O!5~ !T:=NEWSEG[R6]; RL2:=0; SET R2,15 R3:=R1+SECOFF[R6] JR XLX end R6:+1 end LDL RR2,RR0 ...orig. (shouldn't come here) XLX~ restore R6,R7 RET UTABI~ UTABPTR:=^UTAB ...use DATA2 buffer for table of undef. symbols RET ... (save addr + symt ͊!p+q*͍2!p+q*͍2!p+q*͊!p+q*͍!p+q*͍!p+q*͍2!s+p+q+p+q:=2ʦ** w*#"*#"!p+q(+*DM*p*& 6:ep\:=:4> yOB[2ʹ:625o>26=25*R(S2ʹ :50:5G:62625o xB*B"R#DMx*R#DM"#[*RB0w~G( (#w S=qt!ͬt!Ͳ~ R7 then begin GETRDLEN()->R0 R0==R6; JR ULT,GETNSX R0:-R7 R3:=^DATA1; R5:=SYMPTR; R3:->SYMPTR; LDIRB @R3,@R5,R7 READSYM(R3,R0) end R6:+SYMPTR->NXTSYMP R0==R0 GETNS~ <54x ÈG~( ؿ yPx NO ROOMHIT KEYNO CHG ENTER INSERT REPLACE ??? TAG 1 TAG 2 !'!5!.>I>Aͧ~ #͠!S6:S!'~m5EOFO2:(8r!:(6,:5= ͠w[0S0>25*~:524G2Q 2ab ordinal) PUTUTAB~ ...enter with RR2=addr, R5=symtab ordinal to store in UTAB if R1:=UTABPTR>(^DATA2+IN_RL-6) then begin Errm(); DEFT 'LINK SYMTAB FULL ' end LDL @R1,RR2; R5:->@R1[4] UTABPTR:+6 RET PUTNCD~ ...enter with RR2=addr for NCDSEG, als ͧ!t6>!t%\= >!t6:t<2t=O! ~2u b:<2O>9b!60+~9b!60+4:uat:u_2u:uMʉSͧ!v6!"v!|6:|Ҁ!x6 2}:} Hk:} h:}$6 2}$*}M3:}02}O> ͧ3!z#(=(G #=:7

P=27͠ɯ27͠:4!6 N:QB[0:5!62T!T~(5!45ͧ> 25U|~ͪ4͠:6= [*0R!=!6~=5͠ɯ27<26͠ɯ27:426͠:7OX~ POPL RR6; RET GETRDLEN~ ...get len for read when doing symtab ->R3; have SYMSZ,SYMCNT R3:=SYMBFSZ; if R0:=SYMSZ-SYMCNTENDDAT READ(R3,R5) RET FNDSYMI~ UTABPTRQͧ!~:5O͠ɯAͧ y>  F#fhg_!U>?|!U"=t!0!0*=~ #; "=2?J{ 0*=+"=6 ͕ zU̖yͧy>_ > ͠7(4i z +:?M8!*=sT]S=25~>_ y=̪͈͠_ ( *=6 o set RUNSEG LDL NCDSEG,RR2; R2:+YOFFSET->RUNSEG RET LINK~ PROC ...enter with DATA1,2 free, RL3=LU; ret. Z=0 iff invalid type RL3:->LU READ(^MAGIC,HDRSZ) ...header MAGIC==0E007; RET NZ ...invalid file BIT HDRFLG,0; RET NZ ...no reloc. info YOFF6ͭ:}"!}5́ͭ́3*yM"h:}^a a2}O>Vͧ^:}>*z& ~ !z4í!{q*v#"v͙dͧ*vv :{w:x<2xO>}|ͧ yP8 O:4G!6~4y27͠:7 !6~=5>P=27͠:J[*Rw>E28!C~By27( (;͠>*2 +6 ͪ=>I!J>R!Q28:J~B ͗*y27͠:8I [2> _*2 ͈_(:PG{( t 2 :8E '~ ( (:8I >2:=^UTAB+4; RET FNDSYM~ ...find next UTAB entry of symbol# R3 ...have UTABPTR2 @sym_index of next entry with UTABPTR at end of table ...ret. RR2=addr of ref., Z=0 iff none R1:=UTABPTR2 while R10 -!6]:ͧz2~e:~2O! 6*~& 6$>!~_z*~& w!~5Bx:yͧ*v+"vv ~_{ozg001 $$$$ SUB:9(w:8R( ~ # ~ ( #e29͗>*KBOB0 DM!96x 4~6T] x((F~ :8ET]R ~#~( (x(bk#   ȯ!6:7O7+~ :8E:6="2ʹ!6:7 5y27:8R ͠[2~25Ͳ-4] R1:+6->UTABPTR2 R0==R0; RET end R1:+6 end ...Z=0 since past UTABPTR R1:->UTABPTR2 RET CVTSVSYM~ ...convert symbol @R3 to Y format & .SAV it R4:=R3 RL0:=@R4 if BITB RL0,7 not zero then begin RL0:&07F; R4:+1 end else RL0:=SHORTNMOx <  +<OO eNy͖F#~*R8*R0*RB DM (* O͛* ͛(  ͛ͩfo] /](7^D^/])(o] 9]JP (7^/])o]6 9]LD (do begin if R8:=(IN_RL/RELOENTSZ*RELOENTSZ)>R9 then R8:=R9 R9:-R8 R7:=^DATA1 READ(R7,R8) ...reloc data while R8>>0 do begin R6:=@R7[RELOTYP] if BIT R6,15 zero then begin ...if local symbol XLATADR(LDL RR2,@R7; R5:=0); LDL RR10,̀!9~5m:7O{ O  :6GyP8:6!6F4!7Nw#"2+{ xFs!5w 4(!B0>@ͭͲx :8RH>!: ( >P0WzyFͧ>  ͠1ʚ2ʿ3[[)27OB[2ʹy27o> + RH0:=0 Outset() if RL3:=@R4='_' then begin R4:+1; R0:-1 if RL3:=@R4=0 or RL3='_' then RL3:='L' endif end RL3:&05F->@R7'; R4:+1; R0:-1 while R0>>0 and TESTB @R4 not zero do LDIB @R7,@R4,R0 Sav(); RET LABLRe~ := .DO(PUSH R6; PUSH R13) .OUT(" :_!$=(x 0x ͋ >Z x ͋ >Z O0#!!z w#w#w(>V#N#~$#~+: ~@##> ~. #> >  >Gx( ~ #x (@8Z80(.`8}8&($RR2 RDADR() ...read addr to be relocated ->RR2 XLATADR(R5:=R6) R2:+YOFFSET ...further correct segment no. WRADR(LDL RR4,RR10) end else begin ...if external symbol XLATADR(LDL RR2,@R7; R5:=0) ...->RR2 PUTUTAB(R5:=R6&0FFF) end !6~0(4:J*B**e::25H*!~G># 6 S2(y27͠Oʥ:J*t*!Ͳ*# "BͲ &n >N2E*(N !ͬ h!2E"@!Dw: wB(| !<zɯ2F2I<25L"Re) .DO(POP R13; POP R6) ; OUTLREF~ := .DO(PUSH R6; PUSH R13) .OUT("AL"Pp) .DO(POP R13; POP R6) ; READ~ R2:=0FFFF READA~ ...come here with RR2=addr, R5=len R1:=R5 RH0:=LU; RL0:=2 SC 0; RL0==080; RET Z PUSH R7; R7:=^ERRMCD; Outhex(); POP R7 Errm();/898(!8)8(+( -(\(^ x ((#!!z OW_}T]Oů)lau!t"w#͞ x( >!͹   ͞ x( >"͹   S)lgx !!GH 4 # (  >>KBo] R8:-RELOENTSZ; R7:+RELOENTSZ end end restore R6..R11 RET SYMBFSZ~ EQU IN_RL/SYMENTSZ*SYMENTSZ DOSYMTAB~ ...go thru symbol table: save R6,R7 SYMCNT:=0 R3:=^DATA1->SYMPTR->ENDDAT while GETNXTSYM() do begin R7:=SYMPTR RL6:=@R7[SYMTYP] CVT *B~!02HK*BDM~!N~ ({: N~ :D*( :G(~#(:H/o8%#R0w!"@*B~(G#~:EN S2!"@2D>2G2F~!G~(5:E* or(>2I*@+"@|#(~'RDMe:F:E* !5:I ROC ...test for 2 hex chars & save value R7:->LASTDE HEXD(); RET NZ PUSH R6; RL6:=RL3 if HEXD() then begin RL6:*010; RL3:+RL6; RH3:=0 SAVKW(R3) end else begin R7:-1; RESFLG Z end POP R6; RET CHRCON0: PROC ...test for char. con & ret. in RL3 \ aۡSsހSڽ01s0ҧґpwTޘDC@SB޻ _QP MIXED REFe] HHѓю OO ќї֞ WW Ѩѣѥs֩q RR& 80ў01s 11N^] 440^]s 339^^p s!oPfP4!CPMP!oPa`LLP4_QWRITE`LdP4n߼!6` "(`P5c!!!Bء7 ^VcD4!u߽0 1`5NN :Fhͪ:J=* *K R* #oe R8 *0R8 "0ͪSOd ͖"M! !J4ѯ--From here: --To here^ :J* ͖"K! !J4:J=**KR*e!6~04ͪͭBSO2!J~ *5Bif found RL0:=@R7==0D; COMFLG Z; RET NZ R7:+1 if RL0='\' then begin RL0:=@R7==0D; COMFLG Z; RET NZ if DIGIT() then begin PUSH R6; RL6:=RL3 if DIGIT() then begin RL6:*8+RL3 if DIGIT() then begin RL6:*8+RL3 end `^`*^] DD ٠۠ݠߠ LLaP 9ec57<J . > Vt5 sl0sSF;GLDDS  K_QPREDEFINED LABELsǭs}z^`*s߸s0}PIP A:=B:Y PIP A:=B:Y2 PIP A:=B:Y.M PIP A:=B:ZRAM PIP A:=B:ZBAS PIP A:=B:ZSUB PIP A:=B:XX.Z PIP A:=B:ZBUG PIP A:=B:ZASM.Z PIP A:=B:ZXX.Z PIP A:=B:XMETA.Z  =B:Y.M PIP A:=B:ZRAM PIP A:=B:ZBAS PIP A:=B:ZSUB PIP A:=B:XX.Z PIP A:=B:ZBUG PIP A:=B:ZASM.Z PIP A:P54jP5_QOPENaF !1p.{ {p {u5  ;,<>=* !! ~~ !U2TEU 8  0P` P5 ^dhP5!ҁpT /g7bДD]LP3L aPNҷ !q^TLI *B([KSM!J5(5I *MB"M[K [M͗ͪ*0R8(B"0*2R8B0bk"2 e̓t!#w  (;( q:J*͂ ' ̪'"@lS2*MBDM*KR0*MR8 :J=(*͖*Kend RL0:=RL6; POP R6 end else begin case RL0:=@R7 of 'n': RL0:=0D 't': RL0:=9 'b': RL0:=8 'r': RL0:=0D 'f': RL0:=0C end R7:+1 end end RL3:=RL0; R0==R0; RET CHRCON: PROC CHRCON0(); RET NZ SAVKW(RL3:; RH3:=0) RET STv0t1wqt1awDB_QP OUT OF RANGE9_QP ODD DISP. 008820s``??`n`ao^TLPߓ!^Q`P3 !_Z ERROR TOTAL=9Z!P5 X*PLP Y !ҁ!g5d]LP5LPa^"LP5%! q^U q^Uuss0!1Q0TԖ]`PLP3!oo4 9!=GR8*K "K*M "M*@ "@*@x|27[M:J= *K 18'40#1O!K ^#V*R8*R8dE ':J !͂ ~ S227:526ͪ*E :J(T B lʹ:6262527GOz( ~(> !BDMeͭ:J(͂ BR: PROC ...get string, store in req'd buffer, save ("S"^ it) PUSH R8; R8:=^STRBUF while RL0:=@R7<>'"' do begin if RL0='\' and B.@R7[1]=0D then ENDLINE(R7:+1) else begin CHRCON0(); JR NZ,STRX RL3->@R8' if R8>=(^STRBUF+LSTRBUF) then T`oTc     E_QP NOT DEFINEDLP 8 AAa!PJoMU QP7 x   ,,p ߗ!1שs7/7qo 808aPFsQP6Xu5 :43= ɞ2_QREAD! U!Ae hX@b5j i afa3 5aa˩!71!11ߴMrߵߦMara;]/oMMM!! P! ]4!7oo' (KK*MT]BDMe*0R0"[2*MR0 B"2 *KR0"23[MR8B"0*2B"2*K"0DM*2R0C2 "2( (,l[0|( (+B(> ~( oɯͧ rͧAULONG() end end B.0->@R8' M_REQE(R8-^STRBUF->R8)->R3 R1:=R3; R5:=^STRBUF; LDIRB @R1,@R5,R8 ...move string->req'd buff SAVSTRP(R3; R2:=0) ...save ^ to string STRX~ POP R8; RET SAVSTRP := .SAV("S"INS_L) ; CHKONE: PROC ...chk for single char = toaw}Kө9gQp6~gg aPF==שxsSKPHnapppԡC\ӒoCӗ_QPTOO MANY SYMBOLSaPF!11aPF!B/11.80aPF7/7n!@aPF=;( `g ߼L$ ] o !a!ԗ!!x`s!ba ڕa }T!@} N(T!@}:N0fPE]dPa!"fPbPTPP!P1paP"ߗaP"ߗs p([0|(+>2627lS0[0|(+)[0*R( |( +oB_͗!B>E|>2S(*(* ++|(2RS+:R  ( :J!_~!'=(!fz4r͈Omy2RUS=T>~ 2<> 2<2;  value in RL3 RL0:=RL3 B.@R7==RL0; RET NZ R7:->LASTDE B.@(R7:+1)==RL0; COMFLG Z; RET Z R7:-1; RESFLG Z; RET EQSGN: PROC ...chk for single '=' CHKONE(B.'='); RET ANDSGN: PROC ...chk for single '&' CHKONE(B.'&'); RET ORSGN: PROC ...chk for singlg`ө8Юл-ޡ9naPF1a!1o`  C naPF3=3aaP(IGP*KP.KP,;MLAAa PF BН )ߥ`Mc߳a _SbԣaP"aP"q }R_}Z (}R_}Z.(}R_}Z!! }R_}Z/!}R_}Z!`_}Z!1 y0^8rpo^816~o0038'008 :;<=>?@ [\]^ ` {|}~2;U*!*4h N 4:J(ͧP(͠ 21:1A YA *T]~ # ͖* ~# >  !V  J͗ͬ}2,ͬ}2>Jo::O  2!5y(&:=(bk#~ ( (> e '|' CHKONE(B.'|'); RET PNOTTYPSP: PROC ...chk for "(" not followed by B.@R7=='('; RET NZ PUSH R7; R7:+1 Del() ...don't go to new line if TYPESP0() then begin POP R7; RESFLG Z end else begin POP R3; R0==R0 end RET P_TYPESP: PROC ...ch Rem Space=пaPH6_Sb!cC ө8a1o cE x 80p q 1 10p x 8 a`s A_SbMgYZԇ\aԋ`ө81p!sk7 Mp_Sbpo e! x AA ZZ o!Y`p x 00 8 x 00 99 op  AA FF aa ffS""$%B *WS"'߉%W!!3 >CY- 901p00-aa11p x    p x    >!  yO0y    ( !5  (y > !: 2 ͌ͧ͘!!H SCREEN EDITOR - 11/22/82 Gr͚z /IMAGE E.COM !{͚z !+{Wrx*?j" j:Aj2"jky*?j"#j:Ajw*PPw*Y VERS 1.00 -* `P5`n LP`P5 jP5 a `P4!P7r{Y5 LP4ALP4!_Z***** P6 4 0_QP OVER NESTED 5!e!Ը#.xp8bP6e` 堉bP6!^\Ԯq1aP1p.xpoP1poPCaP0 9,/^\ !7qsG3 x '' ""p q""p"PTOO LONGo x  p xaC.{p 8   ,, 80 80 AA#8 uHHp00 99.xp(00 99.xp..xp+11/22/82 Gr͚z /IMAGE E.COM !{͚z ! +{Wr 'x #y N> 0O( O>+y${j>q>GrOA(*p{Ī>2 ͫͧ͟!!H!͹Z ! (AO+| { !Q SCREEN EDITOR -  .xpa!v 41a11pCMP_v 00oP$a-_Z ERROR _Z -NOT FOUNDa- H 901pR !hP3aP&LP!o .[[ !s09p?.xp-[aP$oP&LPФLP5a! tpJqs 8 KK1p? ^^11// ~~0 &$ ++B --B &&SB ||SB **@ //@K.xp0贫p {p sp zp rp.rp.zp.sp.{pjЮ^\ߧߟߦ_gb߭ u po! .xp(PONеH!100 80<fP4^;ԧ u ! 80 ==a xpaPۂ_gbrqTP" '' 8̩0oP$0 80oP$!1aP",4a CC5Œ ^] LP !KP !LPa߷^q! }2?}:]      ;;ʽ x   ;;!  ! }2?}:]!_Z/DO !ogP"oP"oP LP5   騐      #ߵE։+Y^Uf( _k)U#_[v=#-_e}܁܄;[܉;?ܐ~n P2ܔܗ:_ܛܞ;_ܦ/ܩ*s q شsܶDO LܽLOAD LēڻW_UpPACK ALL...CMAIN *ZAP Test Icopy Copyin Copy Outset Out Sav Err0 Re Xc LSTRBUF: EQU 140 STRBUF: DEFS LSTRBUF DECFLG: BYTE 0 ...set=1 if func. decl. BYTE 0 CLRDECFLG: PROC; DECFLG:=0; RET MARKFUNC: PROC; DECFLG:=1; RET ISFUNC: PROC; DECFLG==1; RET HEXBYTE: P_ a30C_aP LP ; JJ"ꠀ0 ^]> a`0ނ^D AA^^Z 80 11% 334 LLL 44.1a߰SsTS ލ0߲1s]sqJ aɡS0mS҅!4Ps  x  psL NP0.80Z  Ԟ .xp!s 8j0@ ??  L ??   ѐP^ݞfP4E!ss1aPaPoPaPs1 ңҤIMAGE" xp    p_S!oorMtޯޱ05AW_Wnm EOF_USTART e_X>BRKS-> !Y_Xt'P-RESET03EXTEND ӯ;CLEARCSEGLPKNONSEGLPTMAP x0h$ h㠉q&nb03}} Tw8_Yaw@1 &߹!߾s_Y/qs1o6З2.8!_Y*_Y !v5!0 &354 5a0B!_Y*!vh 7 BB^ٞ5 ^YJ^Z^Z^Z^Z^[^\^\^e:^eD^d^e$^Ql^ed^e^e^e^e^r BB^ LL^ߓHp 1_rdߘߡ Y|1!_rd+ BB^ LL^߽$rլJ!_rdD.n q EuabWWageaP$aP TP"B_Yb_Y*qQ boP$!^_Y*1LPA_Y*1Q_Y*1aP"O@aP OAS0at.M@.E@.K@.C L itIP/A(/@@DԞ, Pif$([_etqH_e@д_e-)0]8(;[є'@)C]-6ѻ_n|LPR|_faP _pG_f3K񠓣?_rd AApnuҰbZAP d;gגچUqLISTtwOFFbP4~ON?_P݆END GS_T\݅_XְۆݖIF ٠ݜTHEN݈n P0ݤELSEBP0nP0ݰENDIFLP0ݹWRITE 6ݿ,:ݻߞGLOBALDIAGJ83359!v!0 _[52_[y5_[<=>?z|} {{ { { 96.,(*   &$":;0123457pqrstuwTw@_Y a ֞X   d  6Մմ\!_rdV BB^@ LL^6pP՘vЋHoІ ЄВЗ МG BB^СЪйOХ_eШз#c BB =֙; <֦:͞a_ae_`ߨ e q..ECa_Y q::p_`_` _`        x [[ (((_`._`  _`_`a_a<׮_a_`G׳_a!_i|SX_o_ra _f/aP _rdn_rp_YۊALۋۂ۔<<_pۂۛ>>ۆ_f?]ۥWۍیۋۢ۬W3000Uۙۘ۫۔T LL^ BB^иۮ۰3۸њ۸"/ї W0D05۾n۾˞5dP4*_P^/_XZMP,MP.TMPS@UNDEFo0s!oP(=oP*R=܅oP,,܌oP.aP,oP.޿ 2ALLL͞ { 00 zz odP4LMJX ovܯ)ܲ>a`!~8!4VP {ߒ!~J!4P?? ^ g!~^4 99. P!~f4 ' PP??!~k49S!~q4GSP!~}!4VP P֨աȞֈ BB^C?ָ;Mޞ"h>ɞ:r$ֶ;_e* 0_eI:.W+׆6W2 BBS/ז1_eM9 BQW7D00;<;P^FLAGSpLN `R׽Rg100 ȋca8 x  %aL aP&a_YoS_[aL  U_[_[L_P,aP&KP$&! Q Pu u p @@ u[[p | _X_[0KP$].xpp_[7&11$.}2oѪ W4D05уO!_efo. W0C05 ь- ҄ 2,Ҍn -W4C05*ѫ#2.В 2_ef_e_etKOC069H1LfBD7L.pLNqvۮCZ]E=aP orN;o/oravorsvT=Ncr_rBvUݐFރ _Zppލޒ_Shw2  ިEQUݳޕw b޲WORDx eu< ?wBYTEߍ ܣߊ\ _aw:3Vaw:gw>aw8_Y1_YXjر Y W `waw0Q ߥߩߙXٲawgw>Tw1_Ygw> 1_YٲAwQckFLAGSW`e4wNSP {OFFlsLPEыSEGv134_._oW_YѡA.ypѣњgP$_QP ODD BOUNDARY x CC ZZ SS PP VVpw_r q E_laPJ_Z_m ?}:5LPaP$` PaP$oLPaP$LPLPaoP$Հha!uƕoP$n PaP"5/]}2LP?oaPKa7]oaov}2?}:5Dya]v_\3}2?}:1^S^-t[f]5SnjΞn_e[zvڞ6z_e̞+ LL^R BB^љ܅/ܡW܋܊܍܈ܟ܈H BB^Ѳܞ3yя W4000ܪܯܮܱܬܬܽL7ȞD])҂ߌLONGߢߍWߚPROC߰ߤߝߧADDR!۬ ߴinŤn! $n( ۠?1 /aP ' Lo>Aat).IARRAYLP2aP$E1gw>1_Y1_Y}}}$}55(}X gw>_YnSaw>Tw@]w&!0bq_Yow  ]wow^LawTwb!_Y*Tw aw Mw Tw@ &s!u X О?_B   0 0 BB LLWӞ ^ ^ ^ ^ ^R BBn ^8 ^ ^ ^ BB LLn ^ ^ ^ОJJR LԨLOE09H>3YJPL]ԹդJdEI@QS_QD_Fԑ$+ReޤRu_ԻFC PCN4ԴvwaLHߍ BB^: LL^RX_et ҇מW0001 W4001 E_et ґӇ1 ӎݤp҃0W,6W!3>W"9 BB^ӚlѮ#YW4000CBGBYBu00oP$1]D_[ZaP aP$]_Yas݀ߑ#!݋3ߝ\,ݖ9ߩV8ߛORG߈ߟІߋ_oP$*KP *oP"oP ߻DEFSߩi߬۞DEFT_Z߷DEFM_ X??  OTw8gw>bswE _Tw81357 }6377 1 vJ! w 1v>?# p !.}2?}:Tw@Pw^aw00 b2 8*0 8!^B2!1b_Y*bx _nD .xp.xp=_[FjDI^orVIxNVIm|W7C00fgz҈SC~_nx_e8oҕOR_ ҅ҟEX,_ҏҩINҖҰRLңҷRRҪҧLD ҮCP _Ҿ _ҾSL SRSDSUqafGߑLwiJߣߊ]w@LwiBߣB߳ߚߋvX߱QXߨJL'߰Tw03,!_Z$_[d_Z$ _[d.=0̞n N߿ 5S 5 pw,  qp ypC֞Z #! BB^0y>4kҎpҏv3ҋUK݂ҥ݇ҦݍJҾ_etݢݶZݹEQݬNZNEݷCULTNCUGE̞PL ӞMZ'_[.'۩pwAP$oP$gP$zero^YJ^Z^Z^Z^Z^[^\^\^e:^eD^d^e$^Ql0_Zj_Z _ZBCF_Y6A27.XB,.ԉ)HH_[@_YQALR Ҷnaw>\ w^z_nDTw@_[Ԇa_[fjwh^^!`wi ^Tw@ҽTw@]aw>oTw8]\ w^v7u3u}B?1u# p !.O}JaT^o}2oaw8?K aw:  @?!@SSP"LWW__mdGRET EOPOP LDMLDA _n_֛"DIV+LDK -__J_9BIT& ?SET$ERES"_6PANDVXOR_GaINC(gD3Tw]Ӱ x   ,,Tw@ q,,p"nwh!wi]wՁTw]w_[‘ߨ!P!a_Y6]w 80_[ 80_[_[ |.xp 8   ..xp0 |.xp_[>&!A_cuC IڞOVPENOVPO GE  LTGT LE  UGT 'ULE~O! '<W4000$'*%<%ƞ>Զ  dqKwmIbnbh2** ei^cx- tx~rߧpЌ$T}Ж' x  p q''pwЏޗЫ$TޛLе(߿Ск)Фо@ ^Ъ}/aP"_Y޹()6a}:a^vZLP@oP$_r q _Qn! }2oLPE`P_VLwi q//p_g$,SP$0w.9Lwi!,oP$o_gb=H@!nN!}: -DW*-*AKW8000543JTWBD00>=R>?BaOF0LEC*_)XrCLR xCOM~NEGrnӈADC4ӎSBC6_әOUTҰӆӠLDIӓӧLDD Ӛӝ_eӛӵCPIӨӼCPDӯӬRLCӹRRC (ӽTCC_6LWW_t_ a _`QM@Eqqo_[.ө8` 1p+.xp_[ Tw@_[%_[ߚө _[ߥީ _[R0 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10R11R12R13R14R15 N4 FC_[DwD!BUԷ mW0D09YVkT_etӖמL W4000iliniހi~ӪӠ(P+P$< BB^x LL^ ޚ_e* ޤ_e4ޮ_e(> c BB^ LL^1"޿F+W0200~ӞЉu q^^_Y^anЯ sy x ++ -- && ||pw#9 x ** //pw LթվO^$I_LPߢWߧB߬L߱Q)ߺ'#+ LP4 LP<٤Cap x00  p x00 pLP1 qRR_m _m 6 qRRL_LDR-ޞADD __ SUB __ׄSLA SLL_(SRA .SRL_9SDA ?SDL_0JBYTE_m _mҪVWORD_m6^PUSHa MgPw!S#/CCBz  @1p=.xp_[   _[..xp_[ Tw!Oߚߨ_R     _Rܗ ߹_Rܫps   '  ݄_e.H_[dŞ0O؞_X5anj'y_p$W1C09 * $W5C09 ! K0W1C01- ;W5C01#8 #՗Lմ^:ҵ<TfB3D BB^ LL^տ.xpM^te^_YDpC _YLsmf_Z p_Zjфvalue( QݎU q))pw|вR_Z$p_Zj Х Pђҥ/򂪞/aP"^c&ejoߔ q paP$oP&g_t _`8  p x LLF ﲨ HH P 蘒B RR\L QQfQ oW.W,7O_e%4>O*_e;_fHR.xp_[CLLLLWWLLLLS x OPLjVpLONG_mLxCALR{gr^ԄCALLԇy{wԑLDARԔ4Ԇ_nԃՔԅԟMULTԓYԏԩDIVLԝ[ԙԳIRETԪ{ԼDJNZ Կ_tԬնԮW_֞LDPS_W3900Ը _zW7900͞LTws_Yx_Y s xp_R$).38<!|,s ?!ssG4B(X ppSC _[ "CALL 9_[ž_Y_[_[1 !aȗ}} C X_.տb h BB^0ԁm߄W8000lol߃ԋ| Ԩߐ> BB^zߛ߫Wߏߒߕߨߨ ߥߧ߽O_eߩ߬߻d BB^߾)WٞՁ _VZfP4waPL_Zդߕ$_Qn[!]տLP0 q//E q p K H_[H_[,֍ ֑ *L֖%,#(8;...2>J081:>5:LW.cRB.iXBB LLpm`s#_n{#_n 3o_e8_rdڂڊڊڒ$ڒښڮ#"_n4_rd>_rdF_rdK_rdQ ɞ@6ɞΞ DIRLDDR _eXCPIRCPDR (CPSICPSD X $OTIR+OTDR 6INIR=INDR2 .HTSET<֮8RTESTFָB\EXTSJӹePUSHLޞޣ޶֬8ֻ Џ޹0;_:)Н_ȀMSЫ_R_rd_rd _WB200ٞ_Z_b_ש__\__f_WB10A߂_2߇_@SFjGWFw  gepPpOfASMSTgCOMMANDfLABELCOLqXCOMM INSTYJ#TestZZ#DelZ~#IcopyZ#Copyin@Z#Copy[*#Outset\#Out\#OutNGe:#SaveD#SavBAd#Gene$#ZpQl$ӂ7yӆtC ܬ߃0ߺߡܹ==b͊0+h-j 6Wޗ_et_n _f?_etek _W4C08 ` k*W4C05(ߐbЖet_ep7_r_rNor NJ_et<;_epN'_rcand,}_q_q_f_n"_n_n"ԃnotԅ_eԎcarry߹_n"ԙ<>ԟ=ԓԕ_eԭ<=ΞԳ>=؞Թ>>=̞ԿhTnMULTLb ^xDBJNZ {_LhrjB_֞ՇCPSIR{ՏCPSDRՃՀ՚LDCTL`ՈգSETFLG՘լRESFLGայCOMFLGժռ)ըճ_   ^eD߈LF`G`GFдл ў  ֞ !!rо h_et2VA_etU׈Ξڞ_sW2000[Z[`_etu)+t_`q{`p~__rd߅_ߋ_ߑ__`aF SCQ0a a x ;;#Err0ed#ReEe|#Xc0e#WRe0Oe#WRe4e#WRe8afa3 5aa˩!71!11ߴMrߵߦMara;]/oMMM!! P! ]4!7ooߛO$ݩСݱ_o#ӊ,يPW6̀(_`oD WW BBԛԚԿdAfAdAoBoFeSnv߫ڮ_r-_r.,4Ȁڭ<<=Ξ>>Ϟ<<><̞_e ՞_e ޞ_e _e?' $CF\nT qaastop"printf(_Z''_[.) pP M8)"Dӯd $               LFLFfGfAEL>L>L>L>L>L>L?fGfGE3MBEaBKFE fCEL ,, .._r x _m F~7ppE (() [[] "" ''  p x  p x  ^YJ^Z^Z^Z^Z^[^\^\^e:^eD^d^e$^Ql^ed^e^e^e^e^r%(,3_rd$& (MF POP R1 ...end 1st POP R3 ...beg. 1st PUSH R7 ...end 2nd PUSH R1 ...end 1st; beg. 2nd R7:=R1 SAVX() ...save 1st POP R3 ...beg. 2nd (this pop & prev. push unneeded with present SAVX) POP R7 ...end 2nd SAVX() ...save 2nd POP R7; RET EXC: PR@/Ԯ_dwڲ[ڷ@ڿ_< [!_d [҈_rd_eW@ڞՓb()&Lv_o_n_fۃ ^_`_rdխ(W81D0%ъ_n!;":JP1ӭDsave=2MrestoreG<Wsetseg O}3} gresseg_-} sreturn y(_gb~)hӵՃcalx Ն_Ys~ՋALՌՇՕpatch$c՛r__qՎ0$ժ[ _Z ՗՞շ]աՔգ_ss?L?LpL?L?L?`p`@  LpJ@CL@L@L@`pLF`pLFn!L> ЃLPd adE7Tв3 q00p_Z$qCL@(MM_\(a%wKR)<2\Q_gbU_,߾p> ps->eݠ߽gege_iQ_gdAU_ӈ.Л_8A_R0_rdЧ_!ЫӂOC Outset(); Xc(); JP OUTDUN ...the following do a recall & shift (left) in preparation for orring: ORe4: PROC; R1:=4; ...JR ORe ...n=no. places to shift=4 ...ORe3: PROC; R1:=3 ...n=3 ORe~ OWRe(); Outhex(RL0:=RL3); RET WRe8: PROC; R1:=8; JR WRe ...n=08-6D_[_nDL6?6_tKH_[C>W(C\)F`- нLDLAL@MBMHJ!JaHaFʡ4u'\!SӋC!SS߀QZ߇!0!>1P_!>!PД!!fAQ aH JQ'\!!S4` A`BJ@ bAaBߡ5(CS9!S.C!S߮gEe_\_reA2_epл̞g_ лdA_ i_ _@Q U__wa_gag0_rT_lMxL~axo|"->axoz 3_Y""={ 8 WRe4: PROC; R1:=4; JR WRe ...n=4 WRe0: PROC; R1:=0 ...n=0 WRe~ OWRe(); HLout(); RET OWRe~ PUSH R1 Re(); R7:-2 Inhex(R3:=R7); RL0:->RL3; RH3:=0 ...get hex # from @R7 POP R1 SDL R3,R1; RET ...OWRE2: RH1:-1; RET Z; R3:*2; JR OWRE2 ...R3*(2^n)->R3 1V,_nҩҔ2@ۻ_`_rdҴ Þ=ȞDDϞKM'~ߞӓ_rd_eaCձpaaȀf qaaputchar!Egetchar!D%close!A_rd(0read!B8write!C ۪_rd$R ' EU.! @ CǩAQ Cݩ@P !S3[NIP!O3j 绕_2_@_D_H^YJ^Z^Z^ZQC!SQ9CaS`AbA>nACoFQR3 ...DE="stk" ptr. ...CALCLP: R3==R1; RET NC ... PUSH R1 ... if HexdA(B.@R3) then begin R1:=4; LDIRB @R7,@R3,R1 end ... ...put # on "stk" ... else begin ... < H2104FFFF_[8Jopen K H2102FFFF7F40G YKM Oad->yQk+]q-cw|i }&o܃.XOR.wt܎<-> ,܁n[_et߂܄ܜܟ*ܑ ܥ/ܗܫ%ܝܚ}x^Z^[^\^\^e:^eD^d^e$^Ql_ZCTest_n&<k+>/[_Y1CLatch._n_r?])C(G)1_rN/MJ06_epJ_r_qE]CErr0Y_qk.OUT(ߪYs.SAV(_q( nȗ_[u~CSavBz ߊ #WaHQҋuoHs1aH11poH}aH1oH!3KBdAaH0 JQ'\1!S<ЌaH JQ'\ S1RaH11 oHnonpnq`o``_e 8nr HH0_[rotns_e~_[J_eaAAќѻg_rDaP _[a_[_epJ08ΞaP$oMa_@Ma_@aAAAa۲bP1MP,MP.MP(MP*_sa_a^_ax ; o=ix`~_`_`a BB LL%  PUSH R3; POPN()->R1 ...pop # from "stk" ... if RL0='^' then EXP0() ... else if RL0='~' then R3:=-R1 ... else begin POPN() ...pop another ... case RL0 of ... '+': R3+R1 ... '-': R3-R1 ... '&': begin RH3&RH1->RH3; RL3&RL1->RL3 e՘ߓaD_rdӨ`Cܺש @ܿaBםȀɞKaaרȀԞ8.߱.C߹_etstkȓ flag!} ג! ޗW_[ stk- +ՏePFߎVfԞ~8 0߽ӐՉՌFxЈCSavЄБ){fЗ{PЛ}ЅУ$ТLДНАГШJ06ЛФЛФж?ПТЭ_YоCой| COutN×H_[_[11p)p"ўCOut),7_ZCIcopy__[J`oLrHHat_e~ 1HH0_[r`GJqE_e~$&񊘍ELqE֞'3`sȨ ȪLs..LsLs Ls Җ3 Lo VҤ?1󪀞ҹU_ x ::p qQQ%%o@!A|azC|ߝoߠo!AzaxCzaa!]Q_`_@@C_`@ @@@CCCo!a| !o!ooQa=o 8AA_Af!A|azC|cff!]Q_`nd ... '|': begin RH3|RH1->RH3; RL3|RL1->RL3 end ... '*': R3*R1 ... '/': R3/R1 ... end ... end ... HLout() ...push answer on "stk" ... POP R3; R3+1 ... end ... POP R1 ... JR CALCLP HexdA: ...test if RL0=hex digit PUSH R7; PUS> SFց5ߧ*LG֐ߘaFoFǞSF ֟Ֆ֦߬K×aF5ؗ SFaFLpLFdG׫݌ݛWC000݁ݘݘ!ݚX ȠݤȡݧݸWݜݡnCOutset"Ԟ*CCopyin"#1"CGenn0.DO( 3_7:;?))_[ACCopy=_nM"H_Z$_[p x )) ,,K eJ0EXamL_h__q x ;; // )) ::p x== p == >> <<dAPPCaLq--Lq>>_o_f_d_ xp ]]_et q((_t߾ ۽؈W0C01_؆opw ؈_etؓ|Ȁؖ{ بW0C04_ئ؏س҅C_0_`AaaM 3M5M1ܐ x )) ,,n Cp_begin_qendif_ then_q__q _rendif while_`_)do_q_.J08+"_r<repeaH R0; R7:=R15+1; Hexd(); POP R0; POP R7; RET ... RL0=='0'; RET C; if RL0<='9' then begin RL0==RL0; RET end ... RL0=='A'; RET C; if RL0<'F' then RL0==RL0; RET ...MULT0: ...HL*BC->HL: ... PUSH R7; R3<->R7; 0; MULT1(RH1); MULT1(RL1); POP R7; RET ...DIV0: ...ݠݵ} ߭߈ߴ ߉ߺX ߐ] !! ߸_et0ƞ  ߤ-՞͞ܞ_R _e8_OC03_ȗ __W2000_'W" _et_Ξ_etp ==,ю:=ђ/ч7эў;>N6z*LASTCRLASTDECNEXTDETP"NCDSEGKP$NCODEPFTABBSEPJEXTADRdPJEXTENDPLUSERCCv_o_et_fX_rdE x ++ -- || &&.XOR.<->М x ** // %%_rL_ep_YАӣ^  Ğ_rd  T 3 aP _et_rdaP _rp6["+t_`_q.E1Kcase aҭ_qTof?YendD^until$_qL__e_t_rTY_RBW___e_taP _rZm_lp_rӍelse߬_q_r_qӛJ08ӆ_epӉӚ_r_q%ӬӯorӯJ06ӢӫӶӢ_rӻHL/BC->HL: ... PUSH R7; R7:=-1 ...(if BC=0, answer=-1) ... if RH1|RL1 not zero then repeat R7:+1 until R3-R1 carry; ... R3<->R7; POP R7; RET ...MULT1: ...R.A*R.DE + 256*R.HL -> R.HL ... RH1:=8 ... repeat R3*2; if RLCB RL0 carry then R3+R7 ... until RH1:-_et_et_et_et_etANߔ@֘ ϞӞ  ! !! ֊קзV,  6ֿ֥_ސW`uތ_ޘWhރ~ޕ~U_ޣWs_etފޡ_{ޥާ_޸WޜޟPQuitN[OuthexQPErrmSbOutmsgLSjPutconTVZGetrecOVGetconЁYId&Z DigitZ$HexdhZBNumZjHNumFZR#Latch[.Cnt[dOutpetIgaLkupaLkupnlC]-ߚ߉Ӣߪ]-ߛߦް?<+ߪߵߠN߲ߴ45n[_`Sb_rdak^ _`q QKٓ]}نوٗW8100قٕמȀٙN!>1P!>0J0E_epӸ:ӰLӷӷ;end^ SF_fWF_qSF_WFMF_MF_aF___R_|_v else_r_q__q__ oF':-1_n"+ q;;1L-$8J$_  1 zero; ... RET ...EXP0: ...2**R1->R3 ... 1 ...EXP2: R1==0; RET Z; R3*2; R1:-1; JR EXP2 ...POPN: ...pop # represented by 4 hex digits below DE into HL, dec DE, save A ... PUSH R0; R7:-4 ... InhexW(R7)->R3 ... POP R0; RET ...ReHL: Outset(); Re(); POPN(); ":" Del .DO(RH3:=RL0;RL3:=RL1) SAVKW DEFINE .DO(RL0:=REGT) SETTYP .DO(RL0:=TMPSC) SETSCP) := "save" SVRRS / "restore" RESRRS := "setseg" .OUT("H91F07D0233F00002A50F7D0A97F0") ...set seg'd := "resseg" .OUT("H2DF07D0A97F0") ...resto if ID() then CKTYPDEF() if zero then POP R3 else POP R7 RET PTROBJ := ( {PTROFFS} DOPTRTO / {PTROFFS}) FIXADRVAL ; PTROBJ1 := .DO(PUSH R7) "&" Wh {( CKDEFAB) .DO(POP R3)} := .DO(POP R7) ; PTROBJ2 := {CKDEFARY / .DO(R7:=LAS *ZAPALL R=DEFRWX+1,OPSHPOPL *ZAP BYT WRD DEFRWX *PACKALL OUTOP3 ; ...OUTST2 OUTRe ; OUTST1 := SVREG .OUT("W2000"WRe4 WRe8 WRe8 WRe0 Ig) ; ...OUTST2 := OUTOP2 ; ...SVREG .OUT("W2E00"W0884) ; POSTINC : RL0:=029; JR POSTINCD POSTDEC : RL0:=02B ...fall thr JP OUTDUN ...4 hex digits on stack->HL CalcN: PROC ...recall & calculate expression PUSH R7; Re(); R1:=R7; POP R7; R7->R3 ...R7="stk" ptr. CALCLP~ R3==R1; RET NC PUSH R1 if RL0:=@R3='K' then begin R1:=5; LDIRB @R7,@R3,R1 end ...put # on "sre seg/nonseg mode := "return" {"(" INSTLIST ")"} FUNCEND := "calx" Del .OUT("H7F14","AL"*) ...call external := "patch" .DO(R6:=03) {"r" .DO(RH6:=1)} { .DO(RL6:=2)} .DO(PUSH R6) .DO(RES R3,0;LDL RR4,RR2;POP R6) {"[" TDE;RESFLG Z)} ; PTROFFS := $( ADDOFF / ) ; IDNOTK: PROC ...chk for id not "sizeof" & not moe PUSH R7; Sizeof(); POP R7; COMFLG Z; RET NZ ID(); RET NZ if CKMOE() then R7:=LASTDE COMFLG Z; RET MOENUM: PROC ...chk for id=member of enu: POSTINCD := SavB {.DO(NONSEGMD();RL0:=SRC) / .DO(RL0:+1)} SavB .DO(RL0:=WB) SavB OW8_048 ; SVIMM := SAVNN .SAV(0) ; SVCURT := .SAV(0) / .SAV(1) / SVXTYP ; REGNOTDF: ...test if ACC not a default; ret. R3=reg. to save DEFRWB(); R3:=ACCVAL tk" else begin PUSH R3; POPN() ...pop # from "stk" if RL0='^' then begin R1:=R3; R3:=1; SDAL RR2,R1 end else if RL0='~' then begin COM R3; COM R2; ADDL RR2,#1 end else begin LDL RR4,RR2; POPN() ...pop another case RL0: of '(.DO(if RL0:&0F>=RL6 then RL0:->RL6==RL0)) "]"} Patchsub ; INSCNT : R3:=R7-(^BUFF+2); LDB BUFF+1,RL3; RET WDATA := Del .SAV(Re *) .DO(R7:+1==R7) := { .SAV(Re"%B") / .SAV(Re"%W")} ; PRTBEG := .OUT("H7F46") .DO(NARG:=0) ; PRTumeration; if so, save "K"value ID(); RET NZ if CKMOE() not then begin R7:=LASTDE; RESFLG Z; RET end SVMOEVAL(); RET Int := "int" CK_ ; Char := "char" CK_ ; Float := "float" CK_ ; Double := "double" CK_ ; Struct := "struct" CK_ ; Union := "union" CK_ ;+': ADDL RR2,RR4 '-': SUBL RR2,RR4 '&': begin R3:&R5; R2:&R4 end '|': begin R3:|R5; R2:|R4 end '*': begin PUSH R0; MULTL RQ0,RR4; POP R0 end '/': begin PUSH R0; EXTSL RQ0; DIVL RQ0,RR4; POP R0 end end end RL0:='K'->@R7'; OARG := .DO(ACCVAL:=DEFRW) ACCtoREG .DO(NARG:+2;R3:=ACCVAL) OPUSH ; PRTEND := .DO(RL3:=NARG;RH3:=0) SAVNN PKSP .OUT("W0D09"WRe4) OUTRe .OUT("H7F47") OUTRe EVNBDY0 ; RLST := .DO(R6:=0) $( ) .DO(R3:=R6) ; RLSTITM := .DO(PUSH  Long := "long" CK_ ; Short := "short" CK_ ; Unsigned := "unsigned" CK_ ; Auto := "auto" CK_ ; Extern := "extern" CK_ ; Register := "register" CK_ ; Typedef := "typedef" CK_ ; Static := "static" CK_ ; Goto := "goto" CK_ ; Return := "return" CK_ ; Sizeof :=UTRR2() ...push answer on "stk" POP R3; R3:+1 end POP R1 JR CALCLP POPN~ RL3:=@(R7:-1); RH3:=@(R7:-1); RL2:=@(R7:-1); RH2:=@(R7:-1) R7:-1; RET ...later get tag too OUTRR2: RH2:->@R7'; RL2:->@R7'; RH3:->@R7'; RL3:->@R7'; RET ReK: Outset();R6) Del .DO(PUSH R0) { / .DO(R0:=@R15)} .DO(POP R1;POP R6;while RL1<=RL0 do begin SET R6,R1;RL1:+1 end;R0==R0) := .DO(POP R6) ; TWODOTS := ".." .DO(CPB @R7,#'.';JP Z,NOGOOD;R0==R0) ; SVRMLT1 := .OUT("H1CF9") ; ...note: uses R15=SP  "sizeof" CK_ ; Break := "break" CK_ ; Continue := "continue" CK_ ; If := "if" CK_ ; Else := "else" CK_ ; For := "for" CK_ ; Do := "do" CK_ ; While := "while" CK_ ; Switch := "switch" CK_ ; Case := "case" CK_ ; Default := "default" CK_ ; Enum := "enum" CK_ Re(); POPN(); JP OUTDUN ...# on stack->RR2 TEST: ADDR Test DEL: ADDR Del ICOPY: ADDR Icopy COPYIN: ADDR Copyin COPY: ADDR Copy OUTSET: ADDR Outset OUT: ADDR Out OUTN: ADDR OutN SAV: ADDR Sav SAVB: ADDR SavB GEN: ADDR Gen ZP: ADDR Zp ERR0: ADDR Err0 ...  RSRMLT1 := .OUT("H1CF1") ; SVRSRMLT := .DO(RH3:=RL3;RL3:=RL5-1) SAVNN OUTRe ; SVRRS: ...switch order of bits of R3; 0->R5 RH1:=16; R5:=2 repeat RRC R3; RLC R5 until RH1:-1; R3:=R5; R5:=0; JR SVRSRRS ... RESRRS: R5:=1 ... SVRSRRS: ...enter: R3=word wit ; Hexcode := "hexcode" CK_ ; CK_: PROC ...if @R7=letter/digit, set R7=LASTDE, Z=0; else Z=1 if LETTER() or DIGIT() then begin R7:=LASTDE; RESFLG Z; RET end R0==R0; RET Test: JP TEST Icopy: JP ICOPY Copyin: JP COPYIN Copy: JP COPY Outset: JP OUTSET OuG INITXST { SETSTB / SETSTW}; ZELSEST := "else" ELSEST2 XCOMS ZINST XCOMS ; DECRZ := .DO(PUSH R7) ( .DO(RH0:=WRD) / .DO(RH0:=BYT)) .DO(R0:->ACCVAL) {":-1" Dzero Del .DO(if CPB @R7,#';' then POP R3)} := .DO(POP R7) ; LABXRZ := .OUT("L"Xc  RE: ADDR Re XC: ADDR Xc WRE0: ADDR WRe0 WRE4: ADDR WRe4 WRE8: ADDR WRe8 *ZAPALL TMPS ...*ZAP Link Hash LastNm Nxtpos TMPTAB ENDTAB PUTREC ...in MMETA ...*ZAP XLAT STARIT RetZ SR2 TULONG SRDO HBTHEX OUTWB2 LDI_N2 OUTX OUTDUN OUTCP ...*ZAP ISA2 CPAMIX ISAh bits set corres. to regs. to be saved/restored ... (bits reversed in case of save); R5=0=>save, else restore PUSHL RR8 R3->R8; R9:=0 repeat if BIT R8,R9 not zero then begin R9:->R4 repeat R9:+1 until R9>15 or BIT R8,R9 zero; PUSHL R...Z8000 XX: *ZAP Test Del Icopy Copyin Copy Outset Out Sav Err0 COMMAND := CMD1 / IMMX ; CMD1 := CMD2 ... := "DO " Del .DO(PUSH R7) NOTCR LISTCHK .DO(POP LASTDE) NEWFIL PREPROS_ := "DO " Del NOTCR LISTCHK NEWFIL PREPROS_ ... := "IMAGE " Del Re) Zp ; ZOUTJRF := .OUT("J"Re Ig Pp) ; ZSSEXPR := SVLAB SVLAB ZEXPR ZOUTJRF LABXRZ ; ...called by XX ZEXPR := ZTERM $("or" .OUT("J"Ig Re Xc Pp) LABXRZ SVLAB ZTERM) ; ZTERM := ZTST $("and" ZOUTJRF ZTST) ; ZTST := IFINST XCOMS ZRELAT XCOMS ; ZRELAT := (0 then begin R1:=@R15 ...orig. R5 on stk R5==1; JR Z,SVRR2 if BIT R4,0 zero then begin ...if at even reg. if R5<=4 then begin OPSHPOPL(R4); R4:+2; R5:-2; JR SVRR1 end end el.DO(PUSH R7) {PASSNM} ZAPTMPS FINBUF {IMAGE2} ... .DO(POP LASTDE) IMGSUB := "IMAGE " FINBUF SETIMGDFT {IMAGE2} {IMAGE2} ZAPTMPS IMGSUB := "ORIGIN " ORGI $(Del "CODE=" STCDORG {Del "AT" DLRCD STCDAT} / "DATA=" DLRBSSTELOP1> {RELOPD / Dzero} / {RELOPD2 / Dzero}) := "not" Del ZC EXC / ZC ; ZC := "carry" ZLT / Dzero ZEQ ; RELOP1 := "<>" ZNE / "=" ZEQ ; ZEQ := .SAV(6) .SAV(0E) ; ZNE := ZEQ EXC ; RELOP2 := "<=" ZLE / ">=" ZGE / ">>=" SGE / "<<=" SLE / ">>" SGT / "ENCLN SAVX RE1 ORe ...*ZAP WRe OWRe OWRE2 ABSCH REL8CH REL12CH REL16CH GETCHTYP SETCHTYP ...*ZAP TSTRNG ISA3 AL3 DISP12 TSTRNG12 DISP0 OREL8 OREL12 OREL16 ...*ZAP OORERR OORERR_ CALCLP ...EXP0 EXP2 POPN ...*ZAP DOCALR DOCALL DOCALJP DOJR DOJP A1A A2A A3A Dse begin if R5<=3 then begin SVRR2~ OPSHPOP(R4); R4:+1; R5:-1; JR SVRR1 end end ...save with LDM: PUSH R5 if R1=0 then begin ...if save R3:=16-R9; PUSH R3 DECSP(R3:=R5*2) SVRMLT1() POP R3; POP R5 ...R3=starting  STBSSORG) SETNEWORG := "END " Del "SECTION" ZAPTMPS := "REGIONS" SHWRGNS := "EOF" FILDUN := "START " DLRCD ReV JPNEW := "BRKS->" ("C" BRKStoQ / "P" BRKStoP) := "PACK" MASK PACK := "CLEAR" INITTABS ; CMD2~ := ...SETDLR "MAP" <<" SLT / ">" ZGT / "<" ZLT ; ZLT := .SAV(7) .SAV(0F) ; ZGE := ZLT EXC ; ZLE := .SAV(3) .SAV(0B) ; ZGT := ZLE EXC ; SLT := .SAV(1) .SAV(9) ; SGE := SLT EXC ; SLE := .SAV(2) .SAV(0A) ; SGT := SLE EXC ; ...********** SPCINST := "?" .SAV("' ") PRTBEG WDATA k for combination "(" B.@R7=='('; RET NZ PUSH R7; R7:+1 Del() if TYPESP0() not zero then POP R7 else POP R3 RET PNOTP: PROC ...chk for '(' not followed by ')' B.@R7=='('; RET NZ PUSH R7; R7:+1 Del() if B.@R7=')' then begin POP R7; RESFISP12A TSTRG12A ...*ZAP HLDIV2 TSTRG8A TSTRG8B LKUPA OUTJP *PACK ALL EXP0 EXP2 POPN ...*ZAP DOCALR DOCALL DOCALJP DOJR DOJP A1A A2A A3A DISP12A TSTRG12A ...*ZAP HLDIV2 TSTRG8A TSTRG8B LKUPA OUTJP *PACK ALL K ALL _ [҈_q_di@reg, R5=cnt of regs. SVRSRMLT() end else begin ...if restore PUSH R4 RSRMLT1() POP R3; R5:=@R15 SVRSRMLT() POP R3; INCSP(R3*2) end end POP R5; POPL RR8 end until R9:+1>=16; POPL RR8; R0==R0; RET OPSHPOP: ...enter .DO(if RL0:=@R7='A' then R7:+1; RL0:->MAPTYP) MASK Map := "LIST" Del {"OFF" .DO(RESB DIAGSW,6) / "ON" LSTINT / Quit2 {"END" / LSTINT ?( LFILOPN Outset O_VERSN Outp NOTCR)}} ... ?((LETTER / DIGIT) LFILOPN Outset O_VERSN Outp NOTCR)}} := "WRIT$( WDATA) .SAV(Re"\n"INSCNT) PRTEND := .DO(CPB @R7,#'a';RET C) "stop" .OUT("H0E00") := "printf(" .SAV("'"Cnt*) .DO(R7:+1) PRTBEG $( PRTARG) ")" PRTEND := .DO(SETB RTYPFLG,0;RL0:=TMPSC) REGVLST ... $(Del .SAV(*) DelLG Z end else begin POP R3; R0==R0 end RET IDCOL: PROC ...chk for ID followed by ':' PUSH R7 if ID() then begin PUSH R7; Del(); B.@R7==':'; POP R7 end if zero then POP R3 else POP R7 RET TYPDEFNAM: PROC ...chk for ID def'd as typedef PUSH R7with R1=0 iff save, R3=reg# to do (if restore); save RR4 PUSHL RR4; RH3:=WRD if R1=0 then OPUSH(RL3:=-RL3+15) else OPOP(R3) POPL RR4; RET OPSHPOPL: ...OPSHPOP long PUSHL RR4; RH3:=WRD if R1=0 then OPUSHL(RL3:=-RL3+14) else OPOPL(R3) POPL RR4; RET ! E" { $(Del "," )} WRTCR := "DIAG" .DO(SETB DIAGSW,3) := Quit1 .DO(JP Debug0) := "/" RETSYS ; FILENAME := .DO(CALL FILENM) ; ZAPTMPS~ := .DO(CALL ZAPSTATS) SETDFMSK PACK ; MASK~ := SETDFMSK {RANGE} {Del "UNDEF" SETMNDF / "UNREF" R7:+1; RL0:|7+1 until RL0>=64; ...tab until col. CdLCol (nominally 64) LDB @R7,#'['; R7:+1 repeat R7==^BUFF+LINEL-4; JR UGT,LISTX ...chk if fits in buffer RDaHL(R3); Outhex(RL0:) ...put in ascii of generated code until R(SYMPTR) else begin R1:=SYMPTR; LDL RR2,R1[HIVAL] end SAVKL() RET CKNDFERR_~ ID(); RET NZ; NDFERR() DLRCD: LDL RR2,CDPTR; JR SETDLR DLRCDT: XLCDADR(LDL RR2,CDPTR); JR SETDLR DLRBSST: XLBSSADR(LDL RR2,BSSPTR) SETDLR~ LDL DOLLAR,RR2; R0==R0; RET SVDLR=0D; R7:-1; R0==R0; RET ...SDesSub~ ...store seg. descriptors, chk errors ... ...enter: RR4=beg adr, RR2=end adr, RH1=runseg, RH2=ncdseg (if segs=0, ... ... use RUNSEG, NCDSEG) ... ...as goes on des. record->@SDesPs, ... ... runseg->@(^SegSegs+(SDesPs-^See addr (in Qseg), first setting seg'd ...must be in ram R2:=QSEG LDL RETADR,RR2 OutN(); WORD 014 WORD 03303 010 ...LDR $+014,R3 (after this code) R3:=flag; SET R3,15; R3->flag WORD 03103 6 ...LDR R3,$+0A WORD 05E08 ...JP RETADR~ WORD 0 0 ...addSETMNRF / { SETMCMP { SETMMSK}}} {RANGE} ; RANGE~ := Del "R=" { ReV .DO(R3->MAPBEG)} ?( ?( ReV .DO(R3->MAPEND)) / .DO(MAPBEG->MAPEND)) ; LSTINT~ : SETB DIAGSW,6; EQUFLG:=0; LSTLAB:=0FFFF; RET IMAGE2 := $(DelR3:+1=NCODE; RL0:=']'->@R7' end end else R7:-1 ...back up over tab LISTX~ Outp(); RET INITTABS: PROC ...init. tables RGNINIT(); RELOINIT() M_INIT() CGTABINT(); AREFTABI() TABINT(); RET /SEG RETQ~ ...executed upon returning to Q from imm. e: SAVKL(LDL RR2,DOLLAR); RET SVHEXW := .SAV(OuthexW) ; SVHEXL := .SAV(OuthexL) ; ...save RL2,R3 in hex: SVHEXO := .SAV(.DO(PUSH R3;RL3:=RL2) OuthexB .DO(POP R3) OuthexW) ; ...COMM: ...INSTLIST: Del() ...RINST: ...RW0: ... RESFLG Z; RET *ZAPALL TMPS *gDes)/2) ... ...ncdseg->@(^runseg+(^SegSegs2-^SegSegs)) ... R0:=NCDSEG ... if BITB RL1,7 zero then begin ... if BIT R4,15 not zero then R0:=R4 ... end else RH0:=RL1 ...R0=ncdseg for seg ... RL1:=0 ... if BITB RH1,7 zero then begin ... R1:=RUNSEG; if Br of RETDBG or RETQ goes here RET OutN: PROC ...@ret. addr=len word+bytes to put out @CDPTR R1:=@R15 save R8,R9 R8:=R1; R9:=@R8/2+1; R8:+2 while R9:-1 not zero do begin WRCDW(@R8); R8:+2 end R1:=R8 restore R8,R9 R1:->@R15 R0==R0; RET ...C s "E=" SET_E / "F=S" SETSTRPD) ; WWDATA := WRTADR / WRTSTR ; STRING_ := .DO(CALL STRING) ; Test: JP TEST Del: JP DEL Icopy: JP ICOPY Copyin: JP COPYIN Copy: JP COPY Outset: JP OUTSET Out: JP OUT ...OutN: JP OUTN Sav: JP SAV ..xec. LDRL RSAV,RR2 LDR R2,QSEG; LDR R3,SVQSP; LDL RR14,RR2 ...res. SP R3:=flag; RES R3,15; R3->flag /NONSEG LDRL RR2,RSAV; RET ...NOTIMX~ NCDFLG==0; RET ...no ORG or DEFS during imm. ex. ...IMMX0~ ...save ncode if not already; ret R3=NCODE, RL2=NCDPACKALL  : *ZAP Test Del Icopy Copyin Copy Outset Out Sav Err0 COMMAND := CMD1 / IMMX ; CMD1 := CMD2 ... := "DO " Del .DO(PUSH R3;RL3:=RL2) OuthexB .DO(POP R3) OuthexW) ; ...COMM: ...INSTLIST: Del() ...RINST: ...RW0: ... RESFLG Z; RET *ZAPALL TMPS *IT R4,15 not zero then R1:=R4 ... end ...R1=runseg for seg ... R3:-R5; RET C ...chk end not before beg. (not chking seg. matches) ... R3:+1 ...SDesSb2~ ...enter here with R5 (beg adr) & R3 (len) as going in des. ... ...if len<>0, R0=ncdseg, R1=runseg ...tuff: ...XCOMS := WH ; ...QRULE0~ := .DO(PUSH R7) .SAV(*) SQ Del {":=" .DO(POP R3) / Ig} ... := .DO(POP R7) ; ...QRULE2~ := .DO(CALL QRULEI; CALL QRULE) ; XMETA := PREPROSI_ $(WH "/" FINCDGEN / / Err) ; ... $(WH QRUL.SavB: JP SAVB ...Gen: JP GEN ...Zp: JP ZP Err0: JP ERR0 GETNUM := Del ReV ; HEXADR := { FIXHXAD1 / FIXHXAD2} ; GETADRT := DLRCDT ; GETADRT2 := ; ...get addr in form of target machine ...get addr in forFLG ... R3:=NCODE; RL2:=NCDFLG==0; RET NZ ...fall thru: SAVENCD: R3:=NCODE->SAVNCD; NCDFLG:=1; RET ...ret. R3=NCODE, save other regs RESNCD0: FINCDGEN() ... RESNCD: ...restore NCODE from SAVNCD if NCDFLG<>0; res. NCDFLG if NCDFLG<>0 then begin SET; ...chks len. & 1st char. ...NOTE: above assumes LNGTH even if BIT SFLAGS[R13],ZAPB not zero then begin ...check if zapped R10:=R13; JR LKLUP ...spot can be reused end R3:=R13+(NAME+1) ...pt. R3 to name+1 R7:=R6 ...source starting char. R1: R4:=SDesPs ... RL5:->@R4'; RH5:->@R4' ...store beg. adr. ... RL3:->@R4'; RH3:->@R4 ...store len. ... R4==^SegDes+(4*12); RET UGT ...chk not >12 segs (Z=0), ok last time ... SDesPs:+4 ... R4:=(R4-(^SegDes+3))/2+^SegSegs ...^SegSegs+ ... R1:->@R4 ... R4E2 ... / "/" .OUT(".") / / Err) ; FINCDGEN := .OUT(".") ; ENDLINE := FNDCR ENDLIN PREPROS_ ; PREPROSI_ := .DO(CALL PREPROSI) ; PREPROS_ := .DO(CALL PREPROS) ; EXTDEFN_ := .DO(CALL EXTDEFN) ; FNDCR: PROC ...goto CR in orig. data bum of host machine: GETADR := (Del SVIDVAL / / "$" SVDLR / CKNDFERR_) ?(Del ("+"/"-") .SAV(*) Del SVBINCALC) ; SVBINCALC := .SAV(Re Re) .SAV(Xc Re Re Calc) ; ENDLIN := .DO(CPB @R7,#0D;RET NZ;LISTCHK();R7:+1;NCODE->LSTNCD) Getrec ;CDPTR(R2:=NCDSEG; R3:=SAVNCD) NCDFLG:=0 end RET ...RETNCD: ...SAVNCD->NCODE->R3 ... SETCDPTR(R2:=NCDSEG; R3:=SAVNCD) ... RET ...RESNCDe: ...if NCDFLG<>0, do SETCDPTR from SAVNCD, 1->NCDFLG (called from Err) ... if NCDFLG<>0 then begin ... SETCDPTR=R5 if R1:-1 not zero then begin R7:+1 CPSIRB @R7,@R3,R1,NZ; JR Z,LKLUP end ... BIT SFLAGS[R13],ZAPB ...check if zapped ... JR NZ,LKFIN @R13[SFLAGS]&TABMSK==R9; JR NZ,LKLUP ...chk right logical table BIT SFLAGS[R13],HIDDENB; JR NZ,LKLUP ...chk :+(^SegSegs2-^SegSegs) ...^SegSegs2+ ... R0:->@R4 ... R0==R0; RET CKNOTDOT: CPB @R7,#'.'; COMFLG Z; RET Z ... NOGD~ RESFLG Z ...back up over id, set Z=0 R7:=LASTDE; RET CKDEF0~ LKID(); JR C,NOGD; JR NZ,NOGD; RET LKID: ...look up Id in symbol table witffer R7:=LASTCR; RL0:=0D; R1:=0200; CPIRB RL0,@R7,R1,EQ; R7:-1; RET ID := .DO(R7:->LASTDE) $(LETTER / DIGIT) ; LETTER: PROC ...don't set LASTDE RL0:=@R7&0DF=='A'; RET ULT if RL0>'Z' then begin RL0=='_'; RET NZ end R7:+1; R0==R0; RET DIGIT: LISTCHK := .DO(if BITB DIAGSW,6 not zero then LIST()) ; NOTCR~ CPB @R7,#0D; RET Z; R7:+1; JR NOTCR SAVZ := .DO(SUBL RR2,RR2) SAVKL ; SAVKW := .DO(R2:=0) SAVKL ; SAVKL := .SAV("K"INS_L) ; ONEDOT := "." CKNOTDOT ; TWODOTS := ".." CKNOTDOT ; JSTD: ...chk ! (R2:=NCDSEG; R3:=SAVNCD) ... NCDFLG:=0 ... end ... RET IMMX: SAVENCD() CALL STMT_0 if not zero then begin RESNCD0(); RESFLG Z; RET end OJPBK(R2:=QSEG; R3:=^RETQ) ...code to ret. via RETQ RESNCD0() LDL RR2,NCDSEG PUSH R7; GO_RR2(); POP R7; R0=not hidden BIT SFLAGS[R13],UNDEFB ...Z=1 if symbol defined JR Z,LKEXIT0 ...OK, Z=1,C=0 SETFLG Z,C ...prev. ref: Z=1,C=1 JR LKEXIT LKEND: R8==0; JR NZ,LKEXIT0 ...if don't want linked up (Z=0, C=0) R13:=R10 if R10=0 then begin R3:=TABBSE; R13:=Rhout linking in (get flag) Lkupnl(W.LASTDE); RET LKUPNLRe: ...Re & look up symbol without linking in PUSH R7; Outset(); PUSH R7; Re(); Lkupnl(POP R3) POP R7; RET LKUPRe: ...Re & look up symbol (add to symtab if not found) PUSH R7; Outset(); PUSH R7;  PROC ...ret. RL3=value of char; don't set LASTDE RL3:=@R7=='0'; RET ULT RL3=='9'; RET UGT R7:+1; RL3:-'0'; R0==R0; RET HEXD: PROC ...ret. RL3=value of char; don't set LASTDE DIGIT(); RET Z RL3:=@R7&0DF=='A'; RET ULT RL3=='F'; RET UGT R7:+1; RL3:for "D"/"d" followed by space,tab/cr B.@R7&0DF=='D'; RET NZ R7:+1 if RL0:=@R7<>' ' and RL0<>' ' then RL0==0D RET Z; R7:-1; RESFLG Z; RET MAPUNDF: ...put out map of undefined symbols MAPTYP:=0; SETDFMSK(); SETMNDF(); Map(); RET SETDFMSK: MAPBEG:=0; M=R0; RET ......IMMXIF~ IMMX0(); PUSHL RR2 ...... CONDIF(); JR IMMX2 ...IMMX: IMMX0(); PUSHL RR2 ... CALL STMT_0 ... ...INSTLIST() ...IMMX2~ if zero then OJPBK(R2:=QSEG; R3:=^RETQ) ...code to ret. via RETQ ... POPL RR2; PUSHL RR2 ... RL0:=flag->stk ... PU3+@R3 ...next free loc.->R13 R3:=R13+NAME+R5 ...new end of symbol table R3==ENDTAB ...test if room left in symbol table for new entry JR UGT,TUMANY ...too many symbols RL5:->@R13[LNGTH] ...length of symbol name end R7:=R13+NAME ...R6=^staRe(); Lkup(POP R3) POP R7; RET LKUPRe_T: ...LKUPRe for tag/member PUSH R7; Outset(); PUSH R7; Re(); Lkup_T(POP R3) POP R7; RET LIST~ ...called when bit 6 of DIAGSW is set; enter with R7 pointing to CR Outset(); PUSH R7; R7:=LASTCR; Del() RL0:=@R7; P-('A'-10); R0==R0; RET WH: PROC ...chk for space,tab,endline, or comment and go past ...if PREPFLG=1, endline must have '\' before while RL0:=@R7=' ' or RL0=' ' do R7:+1 if RL0='/' then begin RL0:=@R7[1]=='*'; RET NZ R7:+1 repeat while RAPEND:=0FFFF; MAPCMP:=-(2**ZAPB)-1; MAPMSK:=2**ZAPB; RET SETMNDF: R3:=2**UNDEFB ...fall thru: SETMCMP: R3:&(-(2**ZAPB)-1)->MAPCMP ...fall thru: SETMMSK: SET R3,ZAPB; R3:->MAPMSK; R0==R0; RET ... SETMNRF: R3:=2**REFB; JR SETMCMP FIXHXAD1: ...enter with SH R3 ... FINCDGEN() ... POP R3 ... SETCDPTR(R2:=NCDSEG; R3:) ... RL0:=stk->flag ... POPL RR2; RL2:->NCDFLG ...delay till after FINCDGEN ... RET NZ ... LDL RR2,NCDSEG ... PUSH R7; GO_RR2(); POP R7; R0==R0; RET GO_RR2~ PUSHL RR2 ...fall thru: ... GOX: .rt of source symbol; R5=len. LDIRB @R7,@R6,R5 ...symbol name in table (R7->new end of symbols) if R10=0 then begin if BIT R7,0 not zero then B.0->@R7' ...R7:+1; RES R7,0 ...to even boundary TABLEN() ...store rel. len. of table at TABBSE R3OP R7 if RL0<>0D then begin ...chk not blank or comm. R5:=EQUVAL ...value of equate in case EQUFLG<>0 if EQUFLG=0 then begin PUSH R7; R5:=LSTNCD ...get addr. beg. of line if LETTER(R7:=LASTCR) then R5:->LSTLAB POP R7 end HLouL0:=@R7=0D do ENDLINE() R7:+1 until RL0='*' and B.@R7='/'; R7:+1; JR WH end if RL0=0D then begin PREPFLG==0; RET NZ ENDLINE(); JR WH end if RL0='\' then begin PREPFLG==1; RET NZ B.@R7[1]==0D; RET NZ ENDLINE(R7:+1); JR WH end addr offset on STACK, below that seg# ...put in form for addr & save ReV()->R3; PUSH R3 ReV()->R3; RH2:=RL3; RL2:=0; SET R2,15 POP R3; SAVKL() RET FIXHXAD2: ...enter with addr offset on STACK ...using default seg., put in form for addr & save ReV()..go to addr (long word) on stk (seg/nonseg) with same regs. & flag ... (if nonseg'd on diff. seg., assign default SP, save current) PUSHL RR2; LDL RR2,R15[4] ...get addr SET R2,15; RL2:=0 LDL GO_PSPC,RR2 ...put in prog. status vector R3:=flag SET :=R4 ...base link LINKER() ...link up (R13 at new table entry) end ...LKFIN~ R8==0; JR NZ,LKEXIT0 ...chk LINKSW; Z=0, C=0 SUBL RR0,RR0; LDL @R13,RR0 ...0->HI,LOVAL R0:->@R13[TYPE]->@R13[AGGPTR] RL0:->@R13[SCLASS]->@R13[SLEVEL] ...0->other stuft(R5); R1:=LSTLAB if EQUFLG=0 and R1<>0FFFF then begin R5:-R1 ...R5=LSTNCD-LSTLAB=disp. if RH5=0 and RL5<>0 then begin OutSP(); Outhex(RL0:=RL5) end end end EQUFLG:=0 MOVTXT() ...put in tab + move text to buffer, truncating RET HNUM: PROC ...test for hex digit string & save value if found R7:->LASTDE HEXD(); RET NZ PUSHL RR8; SUBL RR8,RR8 repeat SLLL RR8,#4 ...RR8:*16 RH3:=0; R2:=0; ADDL RR8,RR2 ...RR8:+RL3 until HEXD() not; SAVKL(LDL RR2,RR8) POPL RR8; RET ->R3; LDL RR0,DOLLAR; R2:=R0; SAVKL(); RET WRTADR: PROC ...on STACK=addr in form ("K"value); recall & write out ReV() Outset(); OutADR(); Outlin0() R0==R0; RET WRTSTR: PROC ...on STACK=addr of string in form ("S"value); recall, write ... out string &R3,15 ...changed ...if SEGMD<>0 then SET R3,15 R3->GO_PSFC ...set flag word for execution R3:=DEFSP if not zero or R2=QSEG then begin R2:=QSEG; R3:=R15+8 end LDL XSP,RR2 POPL RR2; R15:+4; R15:->SVQSP ... JP STARTX ... STARTX: ...start execution usf R0:|R9->@R13[SFLAGS] ...SFLAGS=0 + log. table flag MAKSNUM()->@R13[SNUM] RESFLG Z ...set Z=0,C=0 LKEXIT0~ RESFLG C LKEXIT: R13->R3->SYMPTR POP R10; POPL RR8; POPL RR6 ...R7 after source symbol RET TUMANY: CALL Errm; DEFT 'TOO MANY SYMBOLS'; BYTE  if too long if not zero then begin ...Z=1=>no text if R3:=LSTNCD0 and R1:-1 not zero do RL0:->@R7' M_REL(R4) Outlin0() R0==R0; RET WRTCR: PROC; Outset(); Outlin(); R0==R0; RET ...write CR ...PASSNM: PROC; repeat RL0:=@R7' until RL0=' ' or RL0ing GO_PS (must be in ram) PUSH R3; QSEG->W.PSVSEG; R3:=flag; SET R3,15; R3->flag /SEG POP R3 LDRL RR14,XSP WORD 07900 ...LDPS GO_PS: PSVSEG~ WORD 08000 WORD GO_PS /NONSEG OJPBK: ...enter with addr in R3 (RETDBG or RETQ) ...put out code to jp to th" ...QBUG variables follow: TMPSP~ ADDR STACK+080 ...MYSTAK+040 ...diff. SP used during some debug cmds. NBRKS~ EQU 8 BRKLST~ ;WORD 0FFFF[3*NBRKS] ...[inst @brkpt,brkpt addr];addr offst=FFFF=>empty BRKEXT: WORD 0FFFF ...if<>0FFFF,=addr of routine executed pos. at R7 OutSP() ...out 1 sp. PRTNM2~ ...ret. Z=1 iff Name found ... PUSH R1; PUSH R3 if Name() and RH1=0 then begin ...Name rets. R1=disp. R1:->R2 ...save displacement in R2 R3:=R13+NAME ...R3 pts. to name RL1:=@R13[LNGTH]; if RL0:=@HL ... if RL0=0 then RL0+1 ... PUSH R7 ... repeat PUSH R0 ... R7:=^BUFF; HLout(); PRTNM() ...put out addr.+ name ... PUSH R3; Outbuf(); POP R3 ... Deasm(); POP R0 ...HL is inc'ed past inst. ... until RL0-1 zero; ... POP R7; RET LOCSUB~ ...enter w1:=0D ...enter with RL3=capital letter, RL1=letter to chk if at 2nd spot ...ret Z=1 if RL3 matches @R7 made capital & @(R7+1)=RL1 (R7:+1) CHK1C~ RH1:=@R7; RESB RH1,5; RL3==RH1; RET NZ R7:+1; RL1==@R7; RET Z; R7:-1; RESFLG Z; RET NUM_~ := .DO(CALL NUM)en Put1(RL0:=0D); POP R7; RET CHMCHR~ ...chk char. in RL0 & do approp. thing RL0:->RL7 if RL0=8 then begin RL0:=RH1|RL1; RET Z ...if backspace & not 1st pos. if RL1=0 then begin RH1:-1; RL1:=4 end RL1:-1 SCIPOS() ...R3=new screen image poat brk ...SBAddr~ WORD 0FFFF 0FFFF ...addr of sp. brk used by SStep ...SBInst~ WORD 0 ...save inst. from above ...SSP~ WORD 0 ...save SP during SStep STBADDR~ WORD 0FFFF 0FFFF ...addr following inst (dynamic) in Step STBINST~ WORD 0 ...save inst. fromMAXNL0 then begin RL0:='+'->@R7'; Outhex(RL0:=RL2) end R0==R0 end ... POP R3; POP R1 RET ...CHGRR: ...change regs. ... PRTRRS() ...print regs. ... CHGMRR(B.ith DEFT 'str' to look for @^BUFF; RR2=addr to start looking ...just look within seg. R2 PUSH R7; R7:=^BUFF if TESTB @R7 not zero then begin R6:=QSEG; LOCSTR(R1:=0) if zero then Dump1() end POP R7; R0==R0; RET LOCSTR~ ...search for string: RR2- ; A0~ := { ReV / .DO(R3-R3)} .DO(RL0:=RL3) ; GETADR0~ := .DO(LDL RR2,LstDmp;LDL DOLLAR,RR2) ReV ; D2~ if GETADR0() <> then begin if RL0:=@R7<>0D then RL0==','; RET NZ; LDL RR2,RPC_ end GETCNT~ if CPB @R7,#',' then begin R7:+1; PUSHL RR2s., R7=old one repeat Put1(RL0:=8); R7:-1 until R3=R7; RET end RH1==8; RET Z ...if at end of row RL0==' '; JR Z,MVCRS1 if RL0=9 then begin repeat MVCRS() until RL1=0; RET end HexdA(); RET NZ ...chk if hex digit RL0:->@R4; PUSH R1 ...stor above STSP~ WORD 0 ...save SP during Step R_PC0~ LONG 0 ...starting PC of Step BUFP: WORD 0 ...tmp ptr in "L" ...SAVADR~ WORD 0 ...saves addr. after Call inst. (possible spot for sp. bkpt) DmpAdd~ LONG 0 ...pts. to beg. addr. of current dump; update1) ...change them; fall thru: ... PRTRRS~ RL0:=3 ...print all regs. ... PRTRR~ ...if BIT RL0,0=1, print PC, else not ...if BIT RL0,1=1, print other regs. no matter what, else ... just print those registers diff. from prev.--also store as ... prev. v>text, RR6->DEFT 'str', R1 count ...returns: RR2 at beginning of string in memory, Z=1 if found R0:=flag; SET R0,15; R0:->flag /SEG JR CPS0 CPSLUP~ POP R3; POP R7; POP R1 if R1=0 then RESFLG Z else begin CPS0~ LDB RL0,RR6[1]; CPIRB RL0,@RR2,R1,Z ..; A0(); POPL RR2; RET end RL0:=1; R0==R0; RET NS2~ A0(); if RL0=0 then RL0:+1; ...JR NST2 ...Tr2: A0(); if RL0=0 then RL0:=07F NST2~ RL0:->NXTCNT; R3:=^NGFLG; R0==R0; RET RW0 := "R" ({A0} .DO(if RL0<=15 then R0==R0)) ; Dump1~ RL0:=1 ... Dump: PROC ...e in scr. image if RL0>='A' then RL0:-7 RL0:&0F ...RL0=value of char. RL7:=RL1/2+(RH0:=RH1*2); RH7:=0 ...DE=2*B+(C/2) LDL RR2,LstDmp ...^memory region to be changed R3:+R7 ...pt. to memory byte to be changed ...RL0=value to replace in nibble if d to 1 past end LstDmp~ LONG CDPTR0 ...pts. to beg. of last line dumped RRS_~ R0_~ WORD 0 ...regs. stored here R1_~ WORD 0 R2_~ WORD 0 R3_~ WORD 0 R4_~ WORD 0 R5_~ WORD 0 R6_~ WORD 0 R7_~ WORD 0 R8_~ WORD 0 R9_~ WORD 0 R10_~ WORD 0 R11_~ WORD 0 R12_~ WOalue for next time--[plus print byte @PC] ...preserves all regs. RL6:=RL0 ... RH1:=12 if BITB RL6,0 not zero then begin Outset() OutADR(LDL RR2,RPC_) ...print PC PRTNM() Outlin() ... RH1:=6 end Outset() COPYSP(RH1:=3) ...spaces R1:=0.chk 1st char. if zero then begin if RL0:=@RR6-1<>zero then begin ...@R7=length PUSH R1; PUSH R7; PUSH R3; RL1:=RL0; RH1:=0; R7:+2 CPSIRB @RR6,@RR2,R1,NZ; JR Z,CPSLUP ...rem. chars. CPL RR2,RR6; JR Z,CPSLUP ...don't catch teprint RL0 lines starting at RR2 LDL DmpAdd,RR2 RL1:=RL0; if RL0=0 then RL1:+1 repeat PUSH R1; Outset() LDL RR2,DmpAdd; LDL LstDmp,RR2 OutADR() ...address out PUSHL RR2; DNAM(); POPL RR2 ...print last label+disp. PUSH R7; R7:=^BUFF+80; PBITB RL1,0 zero then begin RL0:*16; RL7:=0F ...replacing high nibble end else RL7:=0F0 ...replacing low nibble RL0:->RH7 RDaRR2(); RL0:&RL7+RH7 WRaRR2(RL0:) ...replace byte POP R1 ...fall thru: ... MVCRS~ ...move cursor along under memory dumpRD 0 R13_~ WORD 0 R14_~ WORD 08200 R15_~ WORD 0 N14_~ WORD 0 ...nonseg R14 RFC_~ WORD 0C000 RPC_~ LONG CDPTR0 RRS_0~ ;WORD 0[18] ...prev. value of regs. (thru RFC) stored here NXTCNT~ BYTE 0 ...count of how many NEXT's to do; also=max. depth (by T cmd repeat RRCOPY() until R1:+2=18; ...even regs. Outlin(); Outset() COPYSP(RH1:=3) ... RRCOPY(R1:=16) ...FC R1:=1 repeat RRCOPY() until R1:+2=19; ...odd regs.+flag Outlin(); RET RRNMS~ DEFM 'R0 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10R11R12R13R14R15 N4 FC' st string POP R3; POP R7; POP R1 end R3:-1==R3 end end R0:=flag; RES R0,15; R0:->flag /NONSEG RET HISTORY~ PROC ...print addr.+last label(+disp) of last R.A entries at R_SP LDL RR2,R14_ repeat PUSH R0; PUSHL RR2; RDR1aRR2() DuUSH R7; LDIRB_(R1:=16;R6:=QSEG) LDL DmpAdd,RR2 POP R3; POP R7; PUSH R3 ...HL pts. to 16 bytes just read into buffer RH1:=8 ...count of words repeat Outhex(RL0:=@R3') Outhex(RL0:=@R3') ...print contents of memory OutSP() unt MVCRS1~ if RL1:+1=4 then begin RH1:+1; RL1:=0 end SCIPOS() ...R3=new screen image pos., R7=old one PRTIMG~ R3==R7; RET Z Put1(RL0:=@R7'); JR PRTIMG ...update scr. from scr. image CHMTAB~ BYTE 21 26 31 36 41 46 51 56 60 ...ditto CHGMEM BYTE 0 ...fi), NGFLG~ BYTE 0 ...=1 if doing N, 2 if S, 3 if T, 4 if J, 5 if G, else 0 DBUG := .DO(RL3:='Q') RESDBF ST1 := .DO(RL3:='D') {(.DO(RL0==0)) CHGMEM / Dump} := .DO(RL3:='R') PRTRRS := .DO(RL3:='R') ( / "FC"" RRCOPY~ ...enter with R1=reg # (flag=16); R7->output buf. ...if BIT RL6,1=1, print reg. no matter what; else only print if diff. ... from prev.; also copy reg. value to loc. storing prev. value ...save R1,RL6 PUSH R1 OutSP() R2:=@(R4:=R1*2+^RRS_0) .mp1(R2:=RPC_; R1); POPL RR2; POP R0 R3:+2 until RL0:-1 zero; R0==R0; RET BRK~ PROC ...expects RR2 pointing to brk address; RL0=repeat count ...ret. Z=0 if brks used up or in rom, else Z=1 PUSH R7; PUSH R0; LDL RR6,RR2; PUSHL RR6 if CKBRKPT() not til RH1:-1 zero; RL0:='|'->@R7' POP R3; RH1:=16 repeat if RL0:=@R3>=07F or RL0<020 then RL0:='.' RL0:->@R7'; R3:+1 ...put out ascii until RH1:-1 zero; RL0:='|'->@R7' Outlin(); POP R1 until RL1:-1 zero; R0==R0; RET ...OutADR~ ller SCIPOS~ ...using B & C, get R3,R4=current pos. in screen image; set R7=old one R3:=^CHMTAB RL7:=RH1; RH7:=0; R3:+R7; RL7:=@R3 ...E=tab corres. to B R3:=^BUFF+R7; RL7:=RL1; R3:+R7 R7:=R4; R3->R4; RET HexdA~ ...chk if RL0=hex digit, preserve all  .DO(RL0:=17) / "PC" .DO(RL0:=18) / "N4" .DO(RL0:=16)) .DO(RL1:=RL0*2;RH1:=0;LDA R3,RRS_[R1];R2:=QSEG) CHGMEM := .DO(RL3:='H') NS2 HISTORY := .DO(RL3:='G') .DO(NGFLG:=5) := .DO(RL3:='J') .DO(LDL RPC_,RR2;NGFLG:=..Rn_0 R3:=@(R5:=R1*2+^RRS_) ...Rn_ if R3<>R2 or BITB RL6,1 not zero then begin R3->@R4 ...copy reg. value to store prev. PUSH R3 R4:=3; R3:=R1*R4+^RRNMS if R1<10 then R4:-1 LDIRB @R7,@R3,R4 ...move reg name to buff RL0:='='->@R7'; Hhen begin ...chk if not already brkpt. PUSH R7; CKBRKPT(R7:=0FFFF) ...if not, look for empty slot POP R7; JR NZ,NOBRK ...err if no empty slot R3<->R7; RDR1aRR2(); R1:->@R7 ...copy bkpt word if PutBrkW() not zero then begin ...set bkpt NOBR...print addr in RR2 (incl. seg.) ... RL0:=RH2&0F+'0'; if RL0>'9' then RL0:+7 ... RL0:->@R7' ... RL0:='.'->@R7' ... HLout() ... RET MAXNL~ EQU 10 ...max. no. letters of name to print Name: PROC ...expects an address in RR2 (call $) ...returns: R13=ptr. regs. except RR2 if RL0>='0' and RL0<='9' or RL3:=RL0&0DF>='A' and RL3<='F' then R0==R0 else RESFLG Z RET DEASM~ PROC ...disassemble @RPC_ ...for now, dump 4 words or "CALL NN" if begin PUSH R7; Call(); POP R7 end then begin ...Call sets RR2=RPC_4) := .DO(RL3:='B') LSTBRKS := .DO(RL3:='B') GETCNT := .DO(RL3:='X') BRKSOFF := .DO(RL3:='X') ? := .DO(RL3:='L') { / .DO(LDL RR2,LstDmp;R3:+1==R3)} .DO(PUSHL RR2) Lout(POP R3) ...value of RR->buffer end else begin RL4:=7 if R1<10 then RL4:-1 if R1>15 then begin RL4:=1; OutSP() end RL0:='.'->@R7' COPYSP(RH1:=RL4) end POP R1; RET COPYSP~ repeat OutSP() until RH1:-1 zero; RET ...RH1 spaces->@R7+ CK~ POPL RR2; POP R0; POP R7; RET ...ret. Z=0 if rom end R3<->R7; R3:+2; SET R6,15; LDL @R3,RR6 ...save brk address end CKBRKPT(POPL RR6); POP R0; RL0:->@(R3+3) ...store repeat count POP R7; R0==R0; RET PutBrkW~ ...put out break word @RR2, to symbol of greatest value <=$ in same seg ... (call ^LOC), R1=$-LOC; Z=1 if found PUSHL RR6; PUSHL RR8; PUSHL RR10 LDL RR6,RR2; R8:=0FFFF->R10 RL0:=0 while Nxtsym(RL0:)->R11 zero do begin if @R11[SFLAGS]&(2**UNDEFB+2**ZAPB) zero and CKEXTTYP(R11), R5=inst DEASMC~ LDL RR8,RR2 if RL0:=RH5&0F0=070 then begin ...SC Copy(); DEFT 'SC '; Outhex(RL0:=RL5) end else begin if RL0=0D0 then CALR_() else CALL_() Copy(); DEFT 'CALL ' PRTNM2(LDL RR2,RR8) if not zero then OutADR(L"," .DO(BUFP:=^BUFF+1) $( .DO(PUSH R3) .DO(POP R0;RL0:*010;RL3:+RL0->@BUFP;BUFP:+1;R0==R0)) .DO(R3:=BUFP-(^BUFF+1);RL3->B.BUFF;POPL RR2) LOCSUB ... := .DO(RL3:='L') {GETADR0 / .DO(LDL RR2,LstDmp;R3+1==R3)} .DO(PUSHL RR2) "," .HGMEM~ ...change memory: enter with HL->1st mem. spot of 16 PUSHL RR2; Dump1() ...dump 16 bytes of memory CHGMRR() ...make changes; rets. RL1=last input char. POPL RR2; PUSH R1; Dump1() ...display again POP R1; RL1==0D; RET Z ...if CR, done LDL RRret. Z=0 if rom WRR1aRR2(R1:=0E00) CK0E00~ RDR1aRR2(); R1==0E00; RET ...ret. word @RR2 in R1 BRKSOFF~ ...remove all breakpts. R3:=^BRKLST-2; RH1:=NBRKS repeat R3+6 until R0:=@R3<>0FFFF or RH1:-1 zero; RH1==0; RET Z REMBRK() JR BRKSOFF BRKOFF~ ...r then begin GETSYMADR(R11); LDL RR0,RR2 ...symbol value->RR0 if R9:=R7-R1>=zero and R9<=R10 and RH6=RH0 then begin R9:->R10; R11:->R8 end end RL0:=1 end R13:=R8; R1:=R10 R8==0FFFF; COMFLG Z POPL RR10; POPL RR8; POPL RR6; RET DNDL RR2,RR8) end RET end RL4:=4 repeat PUSHL RR2; RDR1aRR2(); HLout(R3:=R1); OutSP() POPL RR2; R3:+2 until RL4:-1; RET ... ...if full Deasm not patched in, just chk for Call ... B.Deasm==05E; R_PC; JP Z,Deasm ... Call(); RET NZ ...if Call, prDO(R3:=^BUFF+1;RL4:=0) ... $( ASCtoN .DO(RL0:->RL5) ASCtoN .DO(RL5:*16+RL0->@R3';RL4:+1==RL4)) ... .DO(POPL RR2;RL4==0;RET Z;LDB BUFF,RL4) LOCSUB := .DO(RL3:='N') NS2 .DO(LDB @R3,#1) := .DO(RL3:='S') NS2 .DO(LDB @R32,DmpAdd; JR CHGMEM ...if LF, repeat with next 16 bytes ...Note: below R4 is used to store current pos. in scr. image CHGMRR~ PUSH R7 R7:=^BUFF; PUSH R7 COPYSP(RH1:=79) ...init. screen image in buffer with spaces R1:=0 ...B=C=0 SCIPOS(); POP R7 .emove breakpt. at R.HL PUSH R7; CKBRKPT(LDL RR6,RR2); POP R7; RET NZ ...ret. if not found R3:+4 REMBRK~ ...enter: @R3=breakpt. addr. offset, @R3[-4]=inst. from breakpt. ...restore inst. & FF out breakpt. addr. LDL RR4,R3[-2]; LD @R3,#0FFFF R0:=@R3[-4AM~ PROC ...same as PRTNM except pads with spaces into a fixed format 1+MAXNL+4 R1:=R7+(MAXNL+5); PUSH R1 PRTNM() POP R1; R1:-R7; COPYSP(RH1:=RL1) RET PRTNM~ PROC ...entered with addr. in RR2 ...prints name of most recent symbol + disp. to current int CALL ?"cc,"SUBR (Call sets HL=R_PC) ... WSbgn() ... CALL Copy; DEFT ' CALL '; BYTE 0 ...doesn't clobber R.A or HL ... if RL0<>0CD then begin CALL Copy; DEFT 'cc,' end ... RDBCaHL(R3+1); PRTNM2(R1) ... WSend(); RET ...UNASM: ...disassemble R.A insts. ,#2) ; ... := .DO(RL3:='T') Tr2 .DO(LDB @R3,#3) ... := .DO(RL3:='U') UNASM CHK1SP~ RL1:=' ' ..."A "/"a " CHK1C(); RET NZ; R7:+1==R7; RET C1SPCRCM~ RL1:=','; CHK1C(); RET Z CK1SPCR~ CHK1SP(); RET Z ..."A " / "A\CR\" CHK1CR~ RL..set init. pos. in scr. image (->HL), DE=beg. PRTIMG() ...print scr. image from DE to HL while begin Get1(); RL0==0D end <> and RL0<>0A do CHMCHR() ...get char. from keybd until CR or LF & do appropriate thing RL0:->RL1 ...ret. RL1=last char. gott# ]; LDL RR2,RR4 ...fall thru: ... ResINST~ ...if @RR2 on set bank=0E00, restore inst. in R0, ret. Z=1; else Z=0 CK0E00(); RET NZ; WRR1aRR2(R1:=R0); RET CKBRKPT~ ...enter with RR6=addr to search for in list of breakpts. ...if R7=FFFF, look for empty slo INCLFLG~ BYTE 0 ...set=1 if #include MACFLG~ BYTE 0 ...bit 0,1 set if have macro in pass, bit 0 reset each pass MREPCNT~ BYTE 0 ...count no. passes over line looking for macros BYTE 0 MBUFPTR~ WORD 0 ...^next place to move to in MBUFF MBUFP0~ WORD :=R5 if RL3&RSZMSK zero then R7:=R1 XLATREG(RL6)->RL3 RL7:|RL3 WRCDW(R7) restore R6,R7 RET PUTLDREG: ...enter RL3=reg. to load from reg. in RL5 save R6,R7 RL6:=RL3 RH6:=RL5®MSK|(RL3:&RSZMSK) if RL6®MSK<>RH6®MSK then begin RH7:=0A1  022 ...BIT,SET,RES (have reg. instead of imm. data) LRTAB5I~ EQU $-REGTAB5I TWOTAB~ ...2 word insts (PC->after) distg'd by 1st byte BYTE 0BA 0BB 0B8 03A 03B ...LDI,CPI,etc, IN,OUT port, INI,etc BYTE 030 031 032 033 034 035 037 ...LD (BA), LDA (BA), *************** WRCDL: PROC ...WRCD for size=4 R5:=4; JR WRCD ... WRCDW: PROC ...WRCD for size=2 R5:=2 ... WRCD~ ...enter RR2=data to write @CDPTR, R5=size; inc CDPTR save R8 R8:=R5 WRMEM(LDL RR4,CDPTR; R1:=R8) INCCDPTR(R8) restore R8 RET XLATt ...Breaklist format: [W.inst,B.seg,B.rpt cnt,W.addr offset] ...if found, R3 at beg. slot R3:=^BRKLST+4; RH1:=NBRKS CKBP1~ repeat RL0:=RH6; SETB RL0,7 if R7=@R3 then begin if R7=0FFFF or RL0=@R3[-2] then begin R3:-4==R3; RET end end R30 ...save pos. of 1st macro in pass DATPTR~ WORD 0 ...^next place to move from LINEND~ WORD 0 ...save end of line pos. in MBUFF MARG~ WORD ARRAY 0[11] ...gets ^'s 1 before & just after for each of 10 ... (calling) macro args NMARGS~ WORD 0 ...no.  if RL6&RSZMSK zero then RH7:=094 RL6:=XLATREG(RL6); RH6:=XLATREG(RH6) RL7:=RH6*16+RL6 WRCDW(R7) end restore R6,R7 RET PUTBSJP: ...put out base part of JP ...RL3=rel op char (=,#,<,>,[,],0=always true), RL5=sign char ('s'/'u') RL3:=GETCCD(RLLDR,LDAR BYTE 070 071 072 073 074 075 077 ...LD (BX), LDA (BX) L2TAB~ EQU $-TWOTAB FNDNXTPC~ ...get next PC after RPC_->RR2 LDL RR8,RPC_; FNPC2() ... Outset(); HLout(R8); HLout(R9); Outlin() LDL RR2,RR8; RET FNPC2~ RDR1aRR2(LDL RR2,RR8); R1:->R5 ...REG: ...enter with RL3=reg#; ret. RL3=code as goes in inst. (word/double) RL0:=RL3 RL1:=RL3®MSK; RH1:=0 RL3:=REGXLTAB[R1] if RL0:&RSZMSK zero then RL3:-1 RET ...below put @CDPTR & update CDPTR (passed regs. as on accstk) PUTSTSTRC: ...put out sto:+6 until RH1:-1; ...not found R3:-10; RET ...Z=0 MBPERL~ EQU 3 ...max. no. of brkpts. to be listed per line LSTBRKS~ ...list addresses of all breakpts. + disp. from last label Outset() R3:=^BRKLST+4; RH1:=NBRKS; RL1:=MBPERL+1 repeat if R0:=@Rof (calling) macro args MAXIFL~ EQU 10 IFSTATE~ BYTE ARRAY 0[MAXIFL] ...each entry: bit 0=1 if true, bit 1=1 =>else IFLVL~ WORD 0 ...init'd PREPROSI: PROC MSTATE:=0; PREPFLG:=0 PREPROS: PROC if MSTATE=0 and PREPFLG=0 then begin if RL0:=@R7='#' or 3,RL5) RH3:=05E; WRCDW(R3); RET PUTBSCALL: ...put out base part of CALL WRCDW(05F00); RET PUTCALLI: ...put out call indirect via reg. RL3 RL3:=XLATREG(RL3)*16; RH3:=01F WRCDW(R3); RET PUTINCSP: ...put out "inc sp" (don't use RETREG); enter with RR2=keep 1st word of inst in R5 if RH5=09E then begin RET_(); RET end if RH5=07F then begin SC_(); RET end if RL0:=RH5&0F0=0C0 then begin R9:+2; RET end ...LDB if RL0=0D0 then begin CALR_(); RET end if RL0=0E0 then begin JR_(); RET end if RL0=0F0 then bre of struct. (block move) indirect from reg.# in RL3 ... to at reg.# in RL5; RR0=size ...Z8000: size assumed<=64K save R6..R9 RH6:=RL5; LDL RR8,RR0 RL6:=XLATREG(RL3); RH6:=XLATREG(RH6) RL3:=REQREG1_(B.WRD)->RL7 ...get another reg (will be diff from 3<>0FFFF then begin if RL1:-1 zero then begin RL1:=MBPERL PUSH R3; Outlin(); POP R3; Outset() end ...if after MBPERLth brkpt., start another line PUSH R3; PUSH R1 OutADR(LDL RR2,R3[-2]) ...put out addr DNAM() ...puIFST_F() then begin INCLFLG:=0 if RL0='#' then begin R7:+1 PREPFLG:=1 ...SETB MSTATE,PREPB if IFST_F() then PREPCMD2() else PREPCMD() PREPFLG:=0 ...RESB MSTATE,PREPB end ... MSTATE:=0 FNDCR() if INCLam't to inc. R3==0; RET Z if R3<=16 then WRCDW(R3-1|0A9F0) ...INC R15,n else WRCDL(R2:=010F; R3:) ...ADD R15,#n RET ...PUTLDCON-PUTSLDA below entered with RL3=reg. to load, RL5=size PUTLDCON: ...enter RL3=reg. to load with constant in RR0; RL5=sizeegin DJNZ_(); RET end ...chk for 1 word insts distinguished by 1st byte: R3:=^ONETAB; R1:=L1TAB; CPIRB RH5,@R3,R1,EQ if zero then begin R9:+2; RET end if R0:=R5&0FF0F=07B00 then begin IRET_(); RET end ...chk for 1 word insts distg'd also by low nibblelast 2) LDL RR0,RR8 if BIT R1,0 zero then SRL R1 PUTLDCON(RL3,2) ...also passes RR0 RH3:=XLATREG(RL7) R2:=0BA01; if BIT R9,0 zero then R2:=0BB01 RL2:|(RL6:*010); RL3:=RH6*010 WRCDL() RELREG_() restore R6..R9 RET PTRADDSUB: ...enter with RL3=dest out last label+disp. COPYSP(RH1:=2) POP R1; POP R3 end R3:+6 until RH1:-1 zero; Outlin(); RET ...the following is for FNDNXTPC: ONETAB~ ...1st byte of 1 word insts (PC->after) distinguished by 1st byte BYTE 03C 03D 03E 03F ...IN,OUTFLG<>0 then begin LISTCHK(); NEWFIL() end ENDLIN() JR PREPROS end end MREPL() ...may ret. R7 at MBUFF with moved text R0==R0; RET IFST_F~ ...ret. Z=1 iff IF state=false; preserve RL0 if R5:=IFLVL<>0 then begin IFSTATE[R5:-1]& save R6..R9 RL7:=RL5; LDL RR8,RR0 RL6:=XLATREG(RL3) if TESTL RR8 zero then begin ...if K=0 RH3:=083 if RL7>2 then RH3:=092 RL3:=RL6*16+RL6 WRCDW(R3) end else if CPL RR8,#16 'K' then begin ...if const, already multiplied if R8<>0 then EXB RL6,RL7 ...RL6=reg.<>pt @R BYTE 07A 07C 07D ...HALT,EI,DI,LDCTL BYTE 0AE 0AF ...TCC BYTE 0B0 0B1 0B4 0B5 0B6 0B7 0BC 0BD 0BE ...DA,EXTS,ADC,SBC,RRD,LDK,RLD L1TAB~ EQU $-ONETAB ONETABN~ ...1 word insts distg'd also by low nibble (except rotates) WORD 08C01 08C09 08D01 08D0# 1; RET Z end RESFLG Z; RET MREPL~ PROC ...go thru line @R7, moving to MBUFF if any macros & doing ... macro replacement; if any, ret. R7=^MBUFF, else R7=same ...make up to 10 passes over line, starting each time at pos. of ... 1st macro of prev. time if RL7>2 then begin RL3:+010 WRCDW(R3) RH3:=083; RL3:=RL6*010+RL6 end WRCDW(R3) end else begin RL3:=RL6 if RL7>2 then begin RH3:=014; WRCDW(R3) WRCDL(LDL RR2,RR8) end else begin RH3:=021; WRCDW(R3) WRCDW CPIRB RH0,@R3,R1,EQ if zero then begin if RH0=039 then begin LDPS_(); RET end if RH0=01C and BIT R5,0 not zero then R9:+2 ...LDM: 1 word extra CNTREG(); RET end RESB RH0,0 ...chk for regular type distg'd by 5 bits in 1st byte: R3:=^REGTAB5;r, RL7=reg. with ptr RL3:=CONVERT_(RL6,'2'*0100+'s',R1)->RL6 ...convert non-ptr to word int PUTMLTK(RL3; R5:='2'*0100+'s'; LDL RR0,OPDVAL) ...mult. by OPDVAL end RL7:=CNVTACC_(RL7,B.'2') if R8<>0 then EXB RL6,RL7 ADMD:=ADMODE; LDL RR2,OPDVAL; 3 08D05 08D07 ...LDCTLB,SETFLG,RESF,COMF,NOP WORD 07B08 07B09 07B0A 07B0D ...MSET,MRES,etc L1TABN~ EQU $-ONETABN ...regular type insts: ... mode 10/00=1 word, 01=2 words nonseg or short offset else 3 words ... (add 1 or 2 more words for imm. data) ... n ...save other regs>=R6 PUSH R7 MBUFPTR:=^MBUFF MACFLG:=0; MREPCNT:=-1 repeat if MREPCNT:+1=10 then begin Errm(); DEFT 'MACROS OVERNESTED' end RESB MACFLG,0 MREPL1() ...if any macro, move line from @R7->MBUFPTR, doing macros R7:=M(R9) end end restore R6..R9 RET PUTLDREGV: ...load reg. variable; RR0=reg. to load from in regv form ...also called by PUTSTREGV to store instead with R0=0FFFF (else=0) save R6,R7 R7:=R0; RL6:=RL1; RH6:=RL5 RL0:=XLATREG(RL3) RH3:=0A1 if RH6>2  R1:=LRTAB5; CPIRB RH0,@R3,R1,EQ if zero then begin PUSH R0; CNTREG(); POP R0 if RH0=0C and BIT R5,0 not zero then R9:+2 ...sp. imm: add 1 word RET end ...chk for regular type distg'd by 6 bits in 1st byte; ... add 2 words for imm. data if moLDL OPVAL,RR2 RL3:=RL7; RL5:=RL6; RL1:='2' if CDOP='+' then PUTADD() else PUTSUB() ...also passes ADMD,OPVAL ...add/sub lo-word (orig order) if R8<>0 and SZPOINT>2 then begin ...need to copy hi-word of ptr RL6:=XLATREG(RL6)-1; RL6:*010 RL3:=Xote: ONETAB,ONETABN should be checked before these unless missing mode ... cases are specially checked REGTAB6~ ...regular type insts distg'd by 6 bits in 1st byte ... add 1 word for sp. imm. data cases BYTE 013 011 017 015 ...PUSH (ex. imm.),POP BYTE...low-level procedures to put out Z8000 code ...ref'd by CODEGEN: CDOP: BYTE 0 ...used in PTRADDSB,SUBPTRS ADMODE: BYTE 0 OPDVAL: LONG 0 ...passes object size or value of const ...OBJSZ: LONG 0 ...passes object size to PTRADDSUB,SUBPTRS ...ADDSBCD: BYthen RH3:=094 if R7=0FFFF then EXB RL6,RL0 RL3:=RL6*010+RL0 WRCDW(R3) restore R6,R7 RET ...PUTCBSLDA: ...put out base part of LDA (load addr) for code region addr ... PUTDBSLDA: ...put out base part of LDA for data region addr RL3:=XLATREG(RL3) RHde=00 & 3rd nibble=0: RH0:=RH5&03F R3:=^REGTAB6I; R1:=LRTAB6I; CPIRB RH0,@R3,R1,EQ if zero then begin CNTREG() if R5&0C0F0 zero then R9:+4 RET end ...chk for regular type distg'd by 5 bits in 1st byte; ... add 1 word for imm. data if mode=00LATREG(RL7)-1+RL6 RH2:=0A1 WRCDW(R3) end restore R6..R8 RET SUBPTRS: ...enter with RL3=dest. reg., RL5=source reg., R1=size/type of result ...also have CDOP,OPDVAL,ADMODE<>'K'; subtract (or poss. add) ptrs. save R6..R9 RH6:=RL5; R7:=R1; LDL RR 01D 039 ...LDL (->mem),LDPS (not mode 10) BYTE 01C ...TESTL/LDM BYTE 036 ...LDA (not mode 10/00) LRTAB6~ EQU $-REGTAB6 REGTAB5~ ...regular type insts distg'd by 5 bits in 1st byte BYTE 02E ...LD (->mem) (not mode 10) BYTE 02C 028 02A ...EX,INC,DTE 0 ...passes operator code ('+'/'-') to PTRADDSUB,SUBPTRS ADMD: BYTE 0 ...passes addressing mode to PUTAROPs (PUTADD,etc) BYTE 0 OPVAL: LONG 0 ...passes operand value to PUTADD,etc IREG: BYTE 0 ...gets reg. no. for indirect addressing (passed to app3:=076 WRCDW(R3) RET PUTDBSLDV: ...put out base part of LD variable (from data) save R6 RL6:=RL5 RL3:=XLATREG(RL3) RH3:=061 if RL6=1 then begin RH3:=060; RL3:+8 end if RL6>2 then RH3:=054 WRCDW(R3) restore R6 RET GETILDCD: ...enter with R3=off & 3rd nibble=0: R3:=^REGTAB5I; R1:=LRTAB5I; RESB RH0,0; CPIRB RH0,@R3,R1,EQ if zero then begin CNTREG() if R5&0C0F0 zero then R9:+2 RET end ...chk for 2 word insts distg'd by 1st byte: RH0:=RH5; RESB RH0,0 R3:=^TWOTAB; R1:=L2TAB; CPIRB RH5,8,OPDVAL ADMD:=ADMODE RL6:=CNVTACC_(RL3,'2'); RL5:=CNVTACC_(RH6,'2') RL3:=RL6; RL1:='2' if CDOP='+' then PUTADD() else PUTSUB() PUTDIVK(RL3:=RL6; R5:='2'*0100+'s'; LDL RR0,RR8) CONVERT_(RL6,R7,'2'*0100+'s') restore R6..R9 RET ...******* PUTPUSH: EC ...the following distinguish bet. themselves by low nibble: BYTE 0C ...COM,NEG,TEST,TSET,CLR; CP,LD,PUSH (sp. imm., not mode 10) LRTAB5~ EQU $-REGTAB5 REGTAB6I~ ...reg. type distg'd by 6 bits where 3rd nibble=0 =>imm. data BYTE 014 016 012 010 ...rop. ... PUT routines) PSHFLG: BYTE 0 ...used by MLTD0,MLTD2 to mark regs. pushed MODFLG: BYTE 0 ...used by PUTDIV,PUTMOD OPCDW: BYTE 0 ...used by PUTADD,etc OPCDL: BYTE 0 ...ditto REGXLTAB: BYTE ARRAY 3 5 1 ...reg. xlate table; index=reg# as on aset, RL5=size ...ret. RL3=hi-byte of code for indirect load, RL3=0 or 1 if size=1 if R3=0 then begin R3:=01400 case RL5: of 1: R3:=02001 2: RH3:=021 end end else begin R3:=03500 case RL5: of 1: R3:=03001 2: RH3:=031 ...preprocessor LMBUFF~ EQU 0100 MBUFF: DEFS LMBUFF MBUFEND~ MSTATE~ BYTE 0 ...bit 0=1 if in string, bit 1=1 if in comment, ...bit 2=1 if in preprocessor cmd ...bits of MSTATE: STRB~ EQU 0 COMMB~ EQU 1 PREPFLG: BYTE 0 ...set=1 if in preprocessor cmd...enter RL3=reg. to push PUTPP(RL3,09300|(SP*010),09100|(SP*010)) RET PUTPOP: ...enter RL3=reg. to pop PUTPP(RL3,09700|(SP*010),09500|(SP*010)) RET PUTPP: ...enter with RL3=reg. to push/pop; R5=code if word, R1=code if long save R6,R7 RL6:=RL3; R7LDL,ADDL,SUBL,CPL BYTE 018 01A ...MULTL,DIVL LRTAB6I~ EQU $-REGTAB6I REGTAB5I~ ...reg. type distg'd by 5 bits where 3rd nibble=0 =>imm. data BYTE 020 0 02 0A ...LD (->R),ADD,SUB,CP BYTE 04 06 08 ...OR,AND,XOR BYTE 018 01A ...MULT,DIV BYTE 026 024ccstk ...value=reg. code for in inst (word) REGXLTB2: BYTE ARRAY MAXREGNO MAXREGNO 0 0 1 1 ...reg. xlate table in reverse dir.; index=reg. code as in inst ...value=reg# as on accstk ...MLTD0 & MLTD2 know that RR0=MAXREGNO, RR2=reg#0, RR4=reg#1 ...$  end end RET GETSTICD: ...enter with R3=offset, RL5=size ...ret. RL3=hi-byte of code for indirect store, RL3=0 or 1 if size=1 if R3=0 then begin R3:=01D00 case RL5: of 1: R3:=02E01 2: RH3:=02F end end else begin R3:=03700 casWIDTHRV: BYTE ARRAY ...# of regs needed ... BYTE 1 0 1 1 1 2 2 2 ...ALGNRV: BYTE ARRAY ...alignment needed (1=basic reg) ... BYTE 1 0 1 1 1 2 2 2  TN: EQU 2 ALSTACK: EQU 2 FSTRV_A: EQU 6 ...first candidate reg. var. of type A NRV_A: EQU 6 ...number R4:=MARG[R1]+1 R1:+1; R5:=MARG[R1] if MREPCNT<>0 then R8:=DATPTR ...R8=overflow pos. while R4MBUFPTR restore R8..R10 RET LMDEFBUF~ EQU 0100 MDEFBUF~ DEFS LMDEFBUK: ...enter with RL3=reg., R5=value to 'and' with ...here assumes size=int. save R6 R6:=R5 RL2:=XLATREG(RL3); RH2:=07 R3:=R6 WRCDL() restore R6 RET PUTEXT: ...enter with RL3=reg#, RH5=size in ascii ('2'/'4') to extend sign/zero ... to, RH1=starti 1st pass, move rem. line->end of MBUFF R5:=^MBUFEND-1; R4:=LINEND; R1:=R4-R7+1 if R1<>0 then LDDRB @R5,@R4,R1 R7:=R5+1 end R7:->DATPTR ...for use in chking overflow in REPLMAC GETMARGS() if BITB MACFLG,0 zero then MBUFP0:=MBUFPTR ...save poe RL5: of 1: R3:=03201 2: RH3:=033 end end RET PUTLS: ...enter with RL3=acc; R5=code for ld/store/lda with offset inst. ... (incl. base reg.) except low nibble<>0 if byte op, R1=offset ...put out inst. (if offset=0, doesn't add) save R8,. ...return reg. is no. 0: RETREG: EQU 0 ...the following refers to format of accumulator byte (as on ACCSTK in CODEGEN) REGMSK: EQU 0F ...holds register no. from 0..MAXREGNO RSZMSK: EQU 010 ...size of reg. for acc.: 1 (WRD)=word, 0=long WRD: EQU 010 ..F MDEFBUFEND~ MDEFBUFP~ WORD 0 NULSTR: BYTE 0 ...init'd NMACARGS~ BYTE 0 MACIDP~ WORD 0 ...saves ^symtab entry if macro id PREPCMD := Sp "define" Sp DEFMAC0 ? Sp MREPL TOKSTR ...define id as macro; get string & store it := "undef" Sp ng size in ascii ('1'/'2'); RL5,RL1=corres. 's'/'u' ... (signed/unsigned); guaranteed RH1RH6; R7:=R5; RL6:=RL1 if RH1='1' then begin RL3:=XLATREG(RL3|WRD)->RL0 ...use word reg. RL3:*010 if RL7='s' and RL6='s' thens. if 1st macro REPLMAC(POP R3) ...R3=^macro replacement text R7:->DATPTR MACFLG:=3; RET MOVTXTM~ ...move DATPTR..R3->MBUFPTR, update MBUFPTR R5:=MBUFPTR; R4:=DATPTR; R1:=R3-R4 if R5+R1>^MBUFEND then TOOLONG() if R1<>0 then LDIRB @R5,@R4,R1 R5:->MR9 R8:=R1; R9:=R5 RL0:=XLATREG(RL3) if R9&0F not zero then RL0:+8 R3:=R9&0FFF0; RL3:|RL0 if R8<>0 then begin WRCDW(R3) R3:=R8 end WRCDW(R3) restore R8,R9 RET PUTFLDA: ...load frame-ptr rel. addr; RR0=offset if TESTL RR0 zero then PUTLDREGV.additional bits of ACCSTK entry are def'd in CODEGEN ...CGTAB: ...code gen. symtab; tmp. here ... WORD 2+2*NCGHASH ...for len ... WORD 0[NCGHASH] ... ...--entries-- ... WORD 0[0100] ...tmp ... ORG CGTAB+CGTABSZ ...CGTABEND: ...AREFTAB: DEFS AREFTABSZ UNDEFMAC := "include" Sp ("<" / """) SETINCL := PREPCMD2 ; PREPCMD2~ := Sp "ifdef" Sp DOIFDEF := "ifndef" Sp DOIFNDEF := "if" MREPL DOIF_EX := "endif" := "else" ; CONEXPR_~ := .DO(CALL CONEXPR) RH3:=0B1 else begin RH3:=082; RL3:+RL0 end WRCDW(R3) end if RH7='4' then begin RL3:=XLATREG(RH6)->RL0 ...use long reg. (RL6=reg# with RSZMSK=0) RL3:*010->RL1 if RL7='s' and RL6='s' then begin R3:=0B10A; RL3:|RL1 end else begin RH3:=08BUFPTR RET GETMARGS~ ...get ^'s to macro args (calling)->@MARG[], no. args->NMARGS ...^'s actually point 1 before & just after each arg PUSH R6; R6:=0 if B.@R7='(' then begin R7:->MARG[R6:]; R7:+1 repeat while RL0:=@R7<>',' and RL0<>')' do (RL3,B.SZPOINT,FP) ...(R0=0) else PUTLS(R5:=03400|(FP*010)) RET PUTFLDV: ...load variable from stack frame; RR0=offset save R6,R7 RL6:=RL3; R7:=R1 R5:=GETILDCD(R1,RL5)|(FP*010) PUTLS(RL6,R5,R7) restore R6,R7 RET PUTILDA: ...load addr indirect viBUFP0->MBUFPTR ...next pass, start at 1st macro of prev. until BITB MACFLG,0 zero; ...if any macros, go back over line max. 10 times POP R7 if MACFLG<>0 then R7:=^MBUFF RET MREPL1~ PROC ...go thru line @R7, moving to @MBUFPTR if any macros & doin ; DEFMAC0~ PROC PUSH R13 if Lkup_M(LASTDE; R7:) zero then begin ... if Lkupnl(LASTDE; R7:) zero then begin ...if prev. in symbol table ... if BIT SFLAGS[R13],MACB zero then begin ... Errm(); DEFT 'REDEFINED SYMBOL ' ... end if R3:=GETVAL()<3; RL3:+RL0 end WRCDW(R3) end restore R6,R7 RET PUTNEG: ...enter with RL3=reg., RL5=size/type char ('2'/'4'/'d') ...do negate save R6 RH6:=RL5 RL3:=XLATREG(RL3)->RL6 if RH6='d' then begin RH3:=9; WRCDW(R3) ...XOR Rn,#08000 (n=even) R3:=0begin PASSTUF() if not zero then begin Errm(); DEFT 'MACRO REF >1 LINE' end end R6:+1 R7:->MARG[R6] R7:+1 until RL0=')'; end R6:->NMARGS POP R6; RET PASSTUF~ ...go past string, charcon, parens, comment, or 1 char; ra register in IREG; RR0=offset save R6,R7 if TESTL RR0 zero then PUTLDREG(RL3,IREG) else begin RL6:=RL3; R7:=R1 RL5:=XLATREG(IREG)*010 RH5:=034 PUTLS(RL6,R5,R7) end restore R6,R7 RET PUTILDV: ...load variable indirect via reg. in IREG; Rg ... macro replacement; if any, ret. MACFLG=3, MBUFP0=^1st, LINEND=^end ... of moved line (@CR) ...if 1st pass, MSTATE says init. state ...set MSTATE according to if end up in string or comment save R6,R7 R7:->DATPTR RL6:=MSTATE; if MREPCNT<>0 then>^NULSTR then M_REL() ... end else begin ... Lkup(LASTDE; R7:); SET SFLAGS[R13],MACB end RES SFLAGS[R13],UNDEFB SETVAL(R2:=0; R3:=^NULSTR) NMACARGS:=0; MDEFBUFP:=^MDEFBUF R13:->MACIDP POP R13; RET MACARGS~ := "(" $(Sp "," ) ")8000 end else if RH6<='2' then begin RL3:*010+2; RH3:=08D end else begin ...if long, do 0-n->n RL3:=REQREG1_(B.0) RL3:=XLATREG(RL3)->RH6 RH3:=092 RL3:*010+RH6 WRCDW(R3) RH3:=092; RL3:=RL6*010+RH6 WRCDW(R3) RELREG_() RH3:=09et. Z=0 if CR RL0:=@R7==0D; COMFLG Z; RET NZ R7:+1 if RL0='"' then begin PASSTR(); RET NZ end else if RL0=''' then begin PASCHR(); RET NZ end else if RL0='(' then begin while B.@R7<>')' do begin PASSTUF(); RET NZ end R7:+1 end elsR0=offset save R6..R8 RL7:=RL3; R8:=R1 R6:=GETILDCD(R1,RL5) RL3:=XLATREG(IREG)*010; RL6:|RL3 PUTLS(RL7,R6,R8) restore R6..R8 RET PUTSLDA: ...load addr of sp+RR0 if TESTL RR0 zero then PUTLDREGV(RL3,B.SZPOINT,SP) ...(R0=0) else PUTLS(R5:=03400|(S$  RL6:=0 MSTATE:=0 ...&(-(2**STRB+2**COMMB)-1) ...0->bits 0,1 while RL0:=@R7<>0D do begin BITB RL6,STRB; JR NZ,IN_STR BITB RL6,COMMB; JR NZ,IN_COM if ID() then begin if ISMAC() then begin ...R3=^symtab entry for macro id DOMAC(R3:)" ; MACARGID~ := Sp ; Sp~ PROC while RL0:=@R7=' ' or RL0=' ' do R7:+1; RET GETMACARG~ PROC ...move last id->@MDEFBUFP +add 0; update MDEFBUFP ...ret. Z=0 if buffer full or >10 args; else Z=1 NMACARGS==9; RET UGT save R8,R9 R9:=MDEF...machine dependent equates: SZCHAR: EQU 1 ...must be SZSHORT: EQU 2 SZINT: EQU 2 SZLONG: EQU 4 SZPOINT: EQU 4 SZFLOAT: EQU 4 SZDOUBLE: EQU 4 SZFPRETAD: EQU 2*SZPOINT ...size of stored old fp & ret. addr. on stack ...below assumed all pwr of 2: ALCHARe if RL0='/' and B.@R7='*' then begin R7:+1 PASCOM(); RET NZ end R0==R0; RET PASSTR~ ...goto end of string or CR; ret. Z=0 if non-escaped CR while RL0:=@R7<>0D and RL0<>'"' do begin PASCHR() B.@R7==0D; RET Z ...escaped CR end B.@R7=='"';P*010)) RET PUTSLDV: ...load variable from stack; RR0=offset save R6,R7 RL6:=RL3; R7:=R1 R5:=GETILDCD(R1,RL5)|(SP*010) PUTLS(RL6,R5,R7) restore R6,R7 RET ...PUTSTREGV-PUTSTS below entered with RL3=reg. from which to store, RL5=size PUTSTREGV: ... ...do macro; update MBUFPTR,DATPTR,R7,MBUFP0 end end else begin RL0:=@R7' if RL0='"' then begin IN_STR~ PASSTR() if B.@R7[-1]='\' then SETB MSTATE,STRB end else if RL0=''' then begin PASCCON() end else if RBUFP; R8:=^MDEFBUFEND R5:=LASTDE repeat STORI(B.@R5') until R5=R7; STORI(B.0) R9:->MDEFBUFP NMACARGS:+1 restore R8,R9 R0==R0; RET STORI~ ...store RL3 @R9, incing R9 & chking for buffer overflow past R8 ...preserve regs. if R9>=R8 then begin TOOLO: EQU 1 ...must be ALSHORT: EQU 2 ALINT: EQU 2 ALLONG: EQU 2 ALPOINT: EQU 2 ALFLOAT: EQU 2 ALDOUBLE: EQU 2 ALSTRUCT: EQU 2 ...should=max. of above ALFTN: EQU 2 ALSTACK: EQU 2 FSTRV_A: EQU 6 ...first candidate reg. var. of type A NRV_A: EQU 6 ...number RET NZ R7:+1; R0==R0; RET PASCCON~ ...go past charcon; ret NZ if CR PASCHR(); RET NZ B.@R7=='''; RET NZ R7:+1; R0==R0; RET PASCHR~ ...go past char. of charcon or string; ret. NZ if CR RL0:=@R7==0D; COMFLG Z; RET NZ R7:+1 if RL0='\' then begin store into reg. var. RR0 PUTLDREGV(R0:=0FFFF); RET PUTDBSST: ...put out base part of store to data region save R6 RL6:=RL5 RL3:=XLATREG(RL3) RH3:=06F if RL6=1 then begin RH3:=06E; RL3:+8 end if RL6>2 then RH3:=05D WRCDW(R3) restore R6 RET PUTSTL0='/' and B.@R7='*' then begin R7:+1 IN_COM~ PASCOM() if not zero then SETB MSTATE,COMMB end end RL6:=0 end if BITB MACFLG,0 not zero then begin ...if a macro on line MOVTXTM(R7+1) LINEND:=MBUFPTR-1 end restore R6NG~ Errm(); DEFT 'LINE TOO LONG' end RL3:->@R9'; RET TOKSTR~ PROC ...enter with MACIDP=^symbol table entry for macro id save R8..R10 R9:=MDEFBUFP->R10; R8:=^MDEFBUFEND while RL0:=@R7<>0D do begin if RL0='"' then begin STORI(RL0); R7:+1 CON of candidate reg. vars. FSTRV_B: EQU 0 ...ditto type B NRV_B: EQU 0 ...type of register for register variable (0='A' type, 1='B' type, -1=none) ... to hold the various types: TPRVCHAR: EQU -1 TPRVSHORT: EQU 0 TPRVINT: EQU 0 TPRVLONG: EQU 0 TPRVPOINT: EQB.@R7==0D; COMFLG Z; RET NZ if DIGIT() then begin if DIGIT() then DIGIT() end else R7:+1 end R0==R0; RET PASCOM~ ...go past comment or to CR; ret. NZ if CR first while RL0:=@R7<>'*' and B.@R7[1]<>'/' do begin RL0==0D; COMFLG Z; RET NZ F: ...frame-ptr rel. store, RR0=offset save R6,R7 RL6:=RL3; R7:=R1 R5:=GETSTICD(R1,RL5)|(FP*010) PUTLS(RL6,R5,R7) restore R6,R7 RET PUTSTI: ...store indirect via reg. IREG, RR0=offset save R6..R8 RL7:=RL3; R8:=R1 R6:=GETSTICD(R1,RL5) RL3:=XLATRE,R7 RET ISMAC~ PROC ...chk if last id=macro; if so, ret. Z=1, R3=addr repl. string PUSH R13 if Lkupnl_M(LASTDE; R7:) zero then begin MRKREF(); R3:=GETVAL(); R0==R0 end else RESFLG Z POP R13; RET DOMAC~ ...enter with R3=addr repl. string for macrTSTR~ while RL0:=@R7<>'"' and RL0<>0D do begin if RL0='\' and B.@R7[1]=0D then begin ENDLINE(R7:+1); JR CONTSTR end STORI(RL0); R7:+1 end if RL0='"' then begin STORI(RL0); R7:+1 end end else if RL0='\' and B.@R7[1]=0DU 0 TPRVFLOAT: EQU 0 TPRVDOUBLE: EQU 0 ...width (or no.) of registers for register variable holding type n: WDRVCHAR: EQU 0 WDRVSHORT: EQU 1 WDRVINT: EQU 1 WDRVLONG: EQU 2 WDRVPOINT: EQU 2 WDRVFLOAT: EQU 2 WDRVDOUBLE: EQU 2 ...alignment with respect to rR7:+1 end R7:+2; R0==R0; RET REPLMAC~ PROC ...enter with R3=^macro replacement text to go @MBUFPTR, ... DATPTR=end of macro id (if MREPCNT>0 then overflow if go past here) ... arguments are pointed to by MARG[], no.=NMARGS ...move in macro text, updG(IREG)*010; RL6:|RL3 PUTLS(RL7,R6,R8) restore R6..R8 RET PUTSTS: ...frame-ptr rel. store, RR0=offset save R6,R7 RL6:=RL3; R7:=R1 R5:=GETSTICD(R1,RL5)|(SP*010) PUTLS(RL6,R5,R7) restore R6,R7 RET PUTSHFT: ...enter with RL3=reg., R5=size/signed co id at LASTDE..R7 ...MBUFPTR=last pos. moved to (or ^MBUFF), DATPTR=last pos. moved from ... (or beg. line); also have MACFLG, MREPCNT, LINEND=end of line prev ... pass ...get macro args (if any) & move repl. text->MBUFF; if already there, ... move r then begin STORI(B.' '); R7:+1 ENDLINE() end else if RL0='/' and B.@R7[1]='*' then begin STORI(B.' '); R7:+2 CONTCOM~ PASCOM() if not zero then begin ENDLINE(); JR CONTCOM end end else if ID() then begin if ISARGM(eg. number for reg. vars. of the various types: ALRVCHAR: EQU 0 ALRVSHORT: EQU 1 ALRVINT: EQU 1 ALRVLONG: EQU 2 ALRVPOINT: EQU 2 ALRVFLOAT: EQU 2 ALRVDOUBLE: EQU 2 ...TYPRV: BYTE ARRAY ...0=A-type; 1=B-type; 0FF=invalid ... BYTE 0 0 0FF 0 0 0 0FF 0FF ...ate MBUFPTR save R8..R10 R10:=R3; R9:=MBUFPTR; R8:=^MBUFEND while RL0:=@R10'<>0 do begin if RL0=0FF and RL1:=@R10>='0' and RL1<='9' then begin R10:+1 RL1:-'0'; RH1:=0 if R1>=NMARGS then begin Errm(); DEFT 'UNMATCHED MACRO ARGS ' end hars. (e.g. '2s'), ... R1=am't to shift; if R1<>0, put out shift save R6,R7 if R6:=R1<>0 then begin RL7:=1 if RH5>'2' then RL7:+4 if RL5='s' then RL7:+8 RL2:=XLATREG(RL3)*010+RL7 RH2:=0B3; R3:=R6 WRCDL() end restore R6,R7 RET PUTMSest of line->end of MBUFF first if not already done ...ret. R7,DATPTR past macro args, set MACFLG ...set MBUFP0=entered MBUFPTR if 1st macro on pass PUSH R3 MOVTXTM(LASTDE) ...move DATPTR..LASTDE->MBUFPTR if MACFLG=2 then begin ...if 1st macro not% ) then begin ...ISARGM rets. RL0=# of arg STORI(B.0FF); STORI(RL0+'0') ...0FF+digit=>arg in token str. end else begin R5:=LASTDE repeat STORI(B.@R5') until R5=R7; end end else STORI(B.@R7') end STORI(B.0) R9:-R10 ...R10=beg. of macbss region ...the following used during init'n: ILVL~ WORD 0 BRCLVL~ WORD 0 BRCLVLI~ WORD 0 ...highest BRCLVL with ILVLB set ILVLB~ BYTE ARRAY 0[MAXBRCLVL] ...level corres. to each brace AGGP~ WORD ARRAY 0[MAXDCLLVL] ...^ to aggtab of next ILVL ILVLSZ~LASS]=EXTDEF or RL0=STATIC then begin if SYMSC=EXTERN then CPTYP() end else if RL0=LABEL then SYMSC==ULABEL RET NZ RELAGG(SYMAGG) R0==R0; RET CKCOMPATN~ ...chk if new symbol compatible with existing one & to keep new ...R13=^old symtab entry; SYMSRR0; LDL FCDPOS,RR2 if CPL RR4,RR8 not zero then MOVDATA(LDL RR2,RR8) ...@RR2'->@RR4' R1 times end restore R8,R9 RET ADJFCDPOS: ...FCDPOS+R3->FCDPOS R2:=0; ADDL RR2,FCDPOS; LDL FCDPOS,RR2; RET FIXDECSP: ...enter with RR2=am't to fill in for dec  ...combine CURTYP,CURAGG (higher level modifier) with type in R3 & ... aggptr in R5 (lower or more basic); result->CURTYP,CURAGG save R8..R13 R8:=R3; R9:=R5 ...R8=TYP.LO, R9=AGG.LO R10:=CURTYP; R11:=0 ...R11=cnt R12:=0; R13:=0 ...R12=last aggptr, ro string, R9=length if R9>1 then begin R3:=M_REQE(R9)->R5 LDIRB @R5,@R10,R9 ...move macro string->requested buffer PUSH R13; R13:=MACIDP SETVAL(R2:=0; R3:) ...store start of macro string in symbol table POP R13 end restore R8..R10 RET WORD ARRAY 0[MAXDCLLVL] ...am't of current aggregate so far done ITYP~ WORD ARRAY 0[MAXDCLLVL] ...basic type of array POSPTR~ WORD ARRAY 0[MAXDCLLVL] ...^ to stored info of struct CURBASE~ WORD ARRAY 0[MAXDCLLVL] ...^ to beg. of current strtab buffer C,SYMTYP,SYMAGG,SYMVAL=new if RL0:=@R13[SCLASS]=EXTERN then begin if RL0:=SYMSC=EXTERN or RL0=EXTDEF or RL0=STATIC then CPTYP() end else if RL1:=RL0&BSCMASK=MOS or RL1=MOU then begin if CPTYP() zero then begin LDL RR2,R13[HIVAL]; CPL RR2,SYMVA...declarations SZBTYP~ BYTE ARRAY ...array of sizes of basic types (not strcts); index is type BYTE 0 0 SZCHAR SZSHORT SZINT SZLONG SZFLOAT SZDOUBLE BYTE 0[4] SZINT SZSHORT SZINT SZLONG ALBTYP~ BYTE ARRAY ...array of alignments for basic types; indexR13=1st aggptr in row while R11ULABEL then SYMSC==LABEL end RET NZ RELAGG(@R13[AGGPTR]) R0==R0; RET CPTYP~ ...check if type @R13 & current match @R13[TYPE]==SYMTYP; RET ...later could also compare aggregates RELAGG: ...sta is type BYTE 0 0 ALCHAR ALSHORT ALINT ALLONG ALFLOAT ALDOUBLE BYTE ALSTRUCT ALSTRUCT 0[2] ALINT ALSHORT ALINT ALLONG ...the following 3 arrays give info on allocation of regs for reg. vars & are ... indexed by a type<=DOUBLE with PTR type=0: ...(PTR,_,ays if nec. if R13<>0 then begin ...if last HI mod.=array R0:=GETSZ(R8,R9) repeat ...mult sizes of last HI arrays by size of LO R0*@R13[SDSZ]->@R13[SDSZ]; R1:=R13; R13:=@R13[SDPTR] until R1=R12; end if R9<>0 then begin ...connect aggptr until R5:+1=R7; B.@R4==0; RET Z IA2~ repeat until B.@R4'=0; RL0:+1 end RESFLG Z; RET UNDEFMAC~ PROC ...enter with LASTDE..R7=id to undef if CKMDEF() then begin ...if id def'd as macro, R3=^symtab entry PUSH R13; R13:=R3 SET SFLAGS[R13]RD ARRAY 0[MAXNSTR] ...store snum's corres. to above NPARM~ WORD 0 PARMTAB~ WORD ARRAY 0[MAXNPARM] ...store ^ symtab entries for func. params ENTRSN~ WORD 0 ...snum for "enter func" info supplied by "exit func" RVALLO_A~ BYTE ARRAY 0[NRV_A] ...marks rting at R3, release array tabs down to struct tab (if any) ...don't rel. struct tab if tagged save R6; R6:=R3 while R6<>0 and BITB SDFLG[R6],ARYB not zero do begin R3:=R6; R6:=@R6[SDPTR] M_REL(R3) end if R6<>0 and BITB SDFLG[R6],TAGB zero then CHAR,SHORT,INT,LONG,FLOAT,DOUBLE) TYPRV~ BYTE ARRAY ...0=A-type; 1=B-type; 0FF=invalid BYTE TPRVPOINT 0 TPRVCHAR TPRVSHORT TPRVINT TPRVLONG BYTE TPRVFLOAT TPRVDOUBLE WIDTHRV~ BYTE ARRAY ...# of regs needed BYTE WDRVPOINT 0 WDRVCHAR WDRVSHORT WDRVINTs (R9=AGG.LO) if R12=0 then R9:->CURAGG else R9:->@R12[SDPTR] end R8:->R10->R0; R1:=0 ...cnt no. of modifiers in LO (R8=TYP.LO) while R1MAXTMODS then TUDEEP() R0:=R10&BTMASK; R,ZAPB if R3:=GETVAL()<>^NULSTR then M_REL(R3:) POP R13 end R0==R0; RET CKMDEF~ PROC ...chk if last id=def'd with #define; if so, rets. R3=^symtab ent PUSH R13 if Lkupnl_M(LASTDE; R7:) zero then begin R3:=R13; R0==R0 end else RESFLG Z POP Rallocated reg. vars (0=free, 1=alloc.) RVALLO_B~ BYTE ARRAY 0[NRV_B] LOCALFLG~ BYTE ARRAY 0[MSCPLVL] ...<>0 =>a local symbol in scope level FRMOFFST~ WORD 0 ...current stack offset (from fp) at bottom of local vars. ABSTYP: WORD 0 ...type from abstracM_REL(R6) restore R6 RET CKSLVLDIF~ ...chk if scope level > prev. declared symbol if SCPLVL>@R13[SLEVEL] then R0==R0 else RESFLG Z RET HIDE~ ...mark symbol hidden & get new symtab entry SET SFLAGS[R13],HIDDENB SVENTLAB(R13); PIKLKUPRe() SET SFLAGS WDRVLONG BYTE WDRVFLOAT WDRVDOUBLE ALGNRV~ BYTE ARRAY ...alignment needed (1=basic reg) BYTE ALRVPOINT 0 ALRVCHAR ALRVSHORT ALRVINT ALRVLONG BYTE ALRVFLOAT ALRVDOUBLE MAXDCLLVL~ EQU 10 ...max level for nesting structure declarations MAXBRCLVL~ EQU 10:&(-BTMASK-1) R11:*2; SDL R10,R11; R10:+CURTYP+R0->CURTYP restore R8..R13 R0==R0; RET CVTUP: ...if type R3=char/short, ret. R3=int; if=float, ret. R3=double; ... else R3 unchanged if R3=CHAR or R3=SHORT then R3:=INT if R3=USHORT then R3:=UINT if 13; RET DOIFDEF~ PROC if CKMDEF() then B.1 else B.0; DOIF(); RET DOIFNDEF~ PROC if CKMDEF() then B.0 else B.1; DOIF(); RET DOIF_EX~ PROC ReK(); if TESTL RR2 then B.0 else B.1; DOIF(); RET DOIF~ PROC ...enter with RL3=1 if to start true #if branch, % t declarator ABSAGG: WORD 0 ...aggptr USDABAGG~ WORD ARRAY 0[MXNABAGG] ...save used ABSAGGs for release NABSAGG~ WORD 0 ...index to above ...************* INITDCLX: SCPLVL:=0; ...SETOUTON() ...fall thru: INITDCL: DCLLVL:=0; RET SCTYPDEF: B.TYPEDEF; [R13],HIDINGB RET SVENTLAB~ ...save symbol of symtab entry @R3 Outset(); RL1:=@R3[LNGTH]; RH1:=0 R3:+NAME; LDIRB @R7,@R3,R1 Sav(); RET CKTYPDEF: ...chk if last id=typedef ...if so, set TYPDCL0[DCLLVL] & AGGDCL0 from id's TYPE & AGGPTR LKID(); RET N10 ...max level of braces in init'n STDCTBSZ~ EQU 30 ...unit size for list of types in struct decl. MAXTMODS~ EQU 6 ...max no. of type modifiers MAXNSTR~ EQU 70 ...max no. of ^strings in an init'n MAXNPARM~ EQU 20 ...max no. of func params MSCPLVL~ EQR3=FLOAT then R3:=DOUBLE RET DCLSYM0~ ...set parameters for DCLSYM: SYMVAL=RR2, etc LDL SYMVAL,RR2; SYMTYP:=CURTYP; SYMAGG:=CURAGG; SYMSC:=SCDCL[DCLLVL] ... DCLSYM: ...enter with symbol on STACK; storage class, type & value to declare ... with in SYMS=0 if false if R5:=IFLVL>=MAXIFL then begin Errm(); DEFT "#if's OVERNESTED " end SETIFST(); RET SETIFST~ ...enter R5=new IFLVL-1, RL3=new IFSTATE ...set IFLVL,IFSTATE; if prev. level=false, reset bit 0 of IFSTATE ...ret Z=1 if R5<>0 then begin R1:JR SETDSC SCEXT: B.EXTERN; JR SETDSC SCEXTDEF: B.EXTDEF; JR SETDSC SCSTAT: B.STATIC; JR SETDSC SCREG: B.REGISTER; JR SETDSC SCAUTO: B.AUTO SETDSC~ B.()->SCDCL[DCLLVL]; R0==R0; RET TYPCH: W.CHAR; JR SETDTYP TYPINT: W.INT; JR SETDTYP TYPSH: W.SHORT; JR SETDZ B.@R13[SCLASS]==TYPEDEF; RET NZ RES SFLAGS[R13],REFB @R13[TYPE]->TYPDCL0[DCLLVL]; @R13[AGGPTR]->AGGDCL0[DCLLVL] R0==R0; RET DCLMOE: ...enter with constant value on stack, below that symbol ...declare symbol to be a constant with that value ReK(); U 16 ...max scope level to use LOCALFLG MXNABAGG~ EQU 8 ...max no. of ABSAGGs in expr saved for release ...offsets in struct/dim tab: SDSZ: EQU 0 SDFLG: EQU 2 SDBITO: EQU 3 ...struct tab: bit field offset within int SDPTR: EQU 4 ...array tab: ^next taC, SYMTYP, SYMAGG & SYMVAL; scope level=SCPLVL ...if type=ftn returning char/short/float, convert up ...ret. R13,SYMPTR=^symtab entry if SYMTYP&(-BTMASK-1)=FTN then CVTUP(SYMTYP&BTMASK)|FTN->SYMTYP if PIKLKUPRe() zero then begin CKCOMPATO(); RET Z =R5-1 if BITB IFSTATE[R1],0 zero then RESB RL3,0 end RL3:->IFSTATE[R5:] R5:+1->IFLVL R0==R0; RET DOELSE~ PROC R5:=IFLVL repeat R5:-1; RET LT RL3:=IFSTATE[R5:] until BITB RL3,1 zero; ...if else clause, go down a level RL3:.XOR.3 SETIFST(TYP TYPLG: W.LONGT; JR SETDTYP TYPUINT: W.UINT; JR SETDTYP TYP_USH: W.USHORT; JR SETDTYP TYP_ULG: W.ULONG; JR SETDTYP TYPFLT: W.FLOAT; JR SETDTYP TYPDBL: W.DOUBLE; JR SETDTYP TYPSTR: W.STRT; JR SETDTYP TYPUN: W.UNIONT SETDTYP~ W.()->TYPDCL0[DCLLVL]; 0->AGGLDL SYMVAL,RR2 RL0:=MOE if SCDCL[0]=STATIC then SETB RL0,STATICB RL0:->SYMSC; SYMTYP:=INT; SYMAGG:=0 DCLSYM() RET CKMOE: ...chk if last id=member of enum.; if so, ret. SYMPTR=^symtab entry Lkupnl(LASTDE; R7:); RET NZ RES SFLAGS[R13],REFB RL0:=@R13b; str tab: ptr next pos to do or cont buf SDHDRL: EQU 6 ...len of above ...bits of SDFLG: ARYB~ EQU 0 ...set if is array tab TAGB~ EQU 1 ...set if struct tab is tagged CONTB~ EQU 2 ...set if table conts in buffer pointed to by SDPTR INDEFB~ EQU 3 ... if CKCOMPATN() not then begin if CKSLVLDIF() not then begin Errm(); DEFT 'INCOMPATIBLE SYMBOL REDECLARATION' ...RDFERR() end HIDE() SET SFLAGS[R13],REFB end end else SET SFLAGS[R13],REFB ...mark not ref'd RES SFLAGS[R13); RET DOENDIF~ PROC IFLVL==0; COMFLG Z; RET NZ IFLVL:-1 R0==R0; RET SETINCL~ PROC INCLFLG:=1; RET /ZAPALL TMPS /PACKALL  .bit 2=1 if in preprocessor cmd ...bits of MSTATE: STRB~ EQU 0 COMMB~ EQU 1 PREPFLG: BYTE 0 ...set=1 if in preprocessor cmdDCL0[DCLLVL]; R0==R0; RET TYPU: TYPDCL0[DCLLVL]+(UINT-INT)->TYPDCL0[DCLLVL]; R0==R0; RET DCLNUL: CURTYP:=0; CURAGG:=0; R0==R0; RET DCLPTR: COMBDC0(PTR); RET DCLFTN: COMBDC0(FTN); RET GETDIMTB: ...enter with R3=dim.; get dim. tab & fill in; ret. R3=^dimta[SCLASS]&BSCMASK==MOE RET SVMOEVAL: ...save value of moe; SYMPTR=^symtab entry R3:=SYMPTR SAVKL(LDL RR2,R3[HIVAL]) RET CKTAG: ...chk if last id=tag (of same type) ...if so, set AGGDCL0[DCLLVL]=id's AGGPTR Lkupnl_T(LASTDE; R7:); RET NZ RL0:=@R13[SCset while struct is being defined DCLLVL~ WORD 0 ...level of declaration SCDCL~ BYTE ARRAY 0[MAXDCLLVL] TYPDCL0~ WORD ARRAY 0[MAXDCLLVL] ...orig. typdcl AGGDCL0~ WORD ARRAY 0[MAXDCLLVL] ...orig. aggptr ...DECL0 in CMAIN rets. type in CURTYP, aggptr in ],UNDEFB if SYMSC=EXTERN or SYMSC=ULABEL then SET SFLAGS[R13],UNDEFB SYMSC->@R13[SCLASS]; SYMTYP->@R13[TYPE]; SYMAGG->@R13[AGGPTR] SCPLVL->@R13[SLEVEL] LDL RR2,SYMVAL; LDL R13[HIVAL],RR2 R0==R0; RET PIKLKUPRe~ ...do LKUPRe or LKUPRe_T depending on SYT R12,BSSSYMB not zero then WRADR_D() else WRADR_C() RES R10,ADRFLGB end else begin R1:=SZPOINT if BIT R12,BSSSYMB not zero then PUTDATADR() ...passes RR2,RR4,R1 else PUTCDADR0() end LDL RR8,RR10 until TESTL RR10 zero; b save R8,R9 R9:=R3 M_REQE(SDHDRL)->R3->R8 ...header for size,flag & poss. ptr. SDTBI(R3) ...zero hdr R9:->@R8[SDSZ] SETB SDFLG[R8],ARYB R3:=R8 restore R8,R9 RET DCLARY: ...'push' array type modifier; dimension is on STACK ...includes getting LASS]&BSCMASK; R1:=TYPDCL0[DCLLVL] if RL0=STNAME and R1=STRT or RL0=UNAME and R1=UNIONT then begin RES SFLAGS[R13],REFB @R13[AGGPTR]->AGGDCL0[DCLLVL]; R0==R0 end ...else Z=0 RET DCLTAG: ...enter with symbol on stack; declare it as struct/union taCURAGG CURTYP~ WORD 0 CURAGG~ WORD 0 ...params. passed to DCLSYM: SYMSC~ BYTE 0 BYTE 0 SYMTYP~ WORD 0 SYMAGG~ WORD 0 SYMVAL~ LONG 0 SCPLVL~ BYTE 0 ...scope level BYTE 0 DNCODE: LONG 0 ...offset into init'd data & code region BNCODE: LONG 0 ...ditto MSC if RL0:=SYMSC&BSCMASK=MOS or RL0=MOU or RL0=STNAME or RL0=UNAME then LKUPRe_T() else LKUPRe() RET CKCOMPATO~ ...chk if new symbol compatible with existing one & to keep old ...R13=^old symtab entry; SYMSC,SYMTYP,SYMAGG,SYMVAL=new if RL0:=@R13[SCrestore R6..R12 RET MOVDOWN: ...enter with RR2=current addr; R5=len of preceding data to move ... down to FCDPOS; update FCDPOS save R8,R9 if R5<>0 then begin R4:=0; LDL RR0,RR4 SUBL RR2,RR4; LDL RR8,RR2 LDL RR2,FCDPOS; LDL RR4,RR2; ADDL RR2,dimension table & filling in ...then do COMBDC ReK()->R3; GETDIMTB(R3)->R5 COMBDC(ARY, R5) RET DCL0: ...'push' orig. type; then do COMBDC COMBDC(TYPDCL0[DCLLVL], AGGDCL0[DCLLVL]); RET COMBDC0~ ...do COMBDC with R3 and 0 as params R5:=0 ... COMBDC~& g R1:=TYPDCL0[DCLLVL]->SYMTYP RL0:=STNAME if R1=UNIONT then RL0:=UNAME if SCDCL[0]=STATIC then SETB RL0,STATICB RL0:->SYMSC SYMAGG:=0; SUBL RR2,RR2; LDL SYMVAL,RR2 ...set params for DCLSYM DCLSYM() SET SFLAGS[R13],TAGMB; ...RES SFLAGS[R13],UNDEFB ... DEFM ' {|}~'; BYTE 07F ... p - z ...Id: PROC ...test for upper or lower case seq of letters & digits, starting ... ... with upper case letter; i-o same as Test ... RL0:=@R7=='A'; RET C ... RL0=='Z'; RET UGT ... R7:->LASTDE ... R1:=^XLAT-'0' but not referenced ZAPB: EQU 13 ...6 ...=1 if symbol zapped (reusable) MACB: EQU 7 ...=1 if defined with #define TAGMB: EQU 6 ...=1 if struct tag or member HIDINGB: EQU 3 HIDDENB: EQU 2 CDREGB: EQU 0 ...=1 if external in code region (ftn/init'd data) TC FDiv; RET FLTCMP: ...RR2=(RR2==RR4) SC FCmp; RET  ޗu_ _ Ğ 4 1!7_ __2!_LTADD: ...RR2+=RR4 SC FAdd; RET FLTSUB: ...RR2-=RR4 SC FSub; RET FLTMULT: ...RR2*=RR4 SC FMult; RET FLTDIV: ...RR2/=RR4 S3:+1; POP R1; RET ...ASCtoN: PROC ...converts ascii char. 0-9,A-F in R.A to its value ... if RL0>='A' then RL0:-7; RL0:&0F; RET InhexO: PROC ...convert 6 hex digits @R3 to value in RR2 Inhex(R3); EXTSB R0; PUSH R0; InhexW()->R3; POP R2; RET InhexL: P GETSTTB() R1:=AGGDCL0[DCLLVL]->@R13[AGGPTR]; SETB SDFLG[R1],TAGB R0==R0; RET GETSTTB: ...get buffer for struct table, pt to & init GETSTTB0(); R3:->AGGDCL0[DCLLVL]; RET GETSTTB0~ ...get buffer for struct table & init; ret R3=^ to it PUSH R6 M_REQE(; RH0:=0 ... repeat ... R7:+1; RL0:=@R7=='0'; JR C,RetZ ... until RL0=@(R3:=R0+R1); ... RET ...Z=1 ...Digit: PROC ...test for a digit ... RL0:=@R7 ... RL0=='0'; RET C ... RL0=='9'; RET UGT ...STARIT~ R7:->LASTDE; R7:+1 ...RetZ~ RL0==RL0; RET ...set ZABMSK: EQU 0C0 ...covers MACB & TAGMB MACRO: EQU 080 TAGM: EQU 040 SETOUTON: OUTSW:=0; RET SETOUTOFF: OUTSW:=1; RET CKOUTON: OUTSW==0; RET Outset: PROC ...set up for OUT functions R7:->NEXTDE R7:=^BUFF RET Outp: PROC ...put out from ^BUFF to R7 (+C*************** WRCDL: PROC ...WRCD for size=4 R5:=4; JR WRCD ... WRCDW: PROC ...WRCD for size=2 R5:=2 ... WRCD~ ...enter RR2=data to write @CDPTR, R5=size; inc CDPTR save R8 R8:=R5 WRMEM(LDL RR4,CDPTR; R1:=R8) INCCDPTR(R8) restore R8 RET XLATROC ...convert 8 hex digits @R3 to value in RR2 PUSH R6 PUSH R3; InhexW(R3); R6:=R3; POP R3; InhexW(R3:+4)->R3; R2:=R6 POP R6; RET InhexW: PROC ...convert 4 hex digits @R3 to value in R3 PUSH R1; Inhex(); RL0:->RH1; Inhex(); RL0:->RL3; RH3:=RH1; POPSTDCTBSZ)->R3->R6 SDTBI(R3) R6+SDHDRL->@R6[SDPTR] R3:=R6 POP R6; RET SDTBI~ ...init header of struct/dim table @R3 to 0 R1:=SDHDRL; RL0:=0 repeat RL0:->@R3' until R1:-1 zero; RET INCDCLLVL~ if DCLLVL:+1>=MAXDCLLVL then TUDEEP(); RET STDCL0: ...in=1, RL0=char. tested ...Hexd: PROC ...test for a hex digit; ret. in RL0 ... Digit(); RET Z ... RL0=='A'; RET C ... RL0=='F'; JR ULE,STARIT ... RL0=='a'; RET C ... RL0=='f'; JR ULE,STARIT ... RET ...false ...Num: PROC ...RL0 has digit; get value of digiR) to file if open, else to $CON RL0:=0D->@R7'; PUTREC() JR OUTDUN ...NEXTDE->DE; 1->Z ... Outlin: PROC ...put out from ^BUFF to R7 (+CR) to console & file if open ...NEXTDE->R7, save other regs>=R4 Outmsg(); JR OUTDUN ... Outlin0: PROC Outbuf(); JRREG: ...enter with RL3=reg#; ret. RL3=code as goes in inst. (word/double) RL0:=RL3 RL1:=RL3®MSK; RH1:=0 RL3:=REGXLTAB[R1] if RL0:&RSZMSK zero then RL3:-1 RET ...below put @CDPTR & update CDPTR (passed regs. as on accstk) PUTSTSTRC: ...put out sto R1; RET InhexB: PROC ...convert 2 hex digits @R3 to value in RL3 Inhex(); RL3:=RL0; RET Outhex: PROC ...RL0 converted to hex & stored at R7 & R7+1; R7=R7+2 PUSH R0; RL0:/16; HBTHEX(); POP R0 HBTHEX~ if RL0:&0F+'0'>'9' then RL0:+7; RL0:->@R7'; RET Oc DCLLVL, set SC=MOS/MOU save R8 R8:=TYPDCL0[DCLLVL] R1:=AGGDCL0[DCLLVL]; SETB SDFLG[R1],INDEFB INCDCLLVL() RL0:=MOS if R8=UNIONT then RL0:=MOU if SCDCL[0]=STATIC then SETB RL0,STATICB RL0:->SCDCL[DCLLVL] restore R8 RET STDCL2: ...make sure end t sequence->R3 ... PUSH LASTDE; R3:=0 ... repeat R3:*2->R1; R3:*4+R1 ... RL1:=RL0&0F; RH1:=0; R3:+R1 ... until Digit() not zero; ... POP LASTDE; R3==R3; RET ...HNum: PROC ...checks for hex no.: value->R3; else R3=0 ... PUSH LASTDE; R3:=0 ... while Hexd OUTDUN ... ...OutN: PROC ... Icopy(); DEFT 'H' ... POP R3; R1:=@R3 ... if RH1=0 then begin RH1:=RL1; R3:+1 end ... R3:+1 ... repeat Outhex(RL0:=@R3') until RH1:-1; ... PUSH R3 ... Out: PROC OUTSW==0; JR NZ,OUTDUN if BITB DIAGSW,3 not zero then begin .re of struct. (block move) indirect from reg.# in RL3 ... to at reg.# in RL5; RR0=size ...Z8000: size assumed<=64K save R6..R9 RH6:=RL5; LDL RR8,RR0 RL6:=XLATREG(RL3); RH6:=XLATREG(RH6) RL3:=REQREG1_(B.WRD)->RL7 ...get another reg (will be diff from uthexB: PROC ...RL3 in hex->@R7' PUSH R0; Outhex(RL0:=RL3); POP R0; RET OuthexL: PROC ...RR2 in hex->@R7' PUSH R3; HLout(R3:=R2); POP R3 ...cont: ... OuthexW: PROC HLout: PROC ...put out R3 in hex at R7, incrementing R7 PUSH R0; Outhex(RL0:=RH3); of struct/union on ALSTRUCT bdy.; dec DECLVL save R8 R8:=AGGDCL0[DCLLVL-1] if B.@R8[SDBITO]<>0 then begin CURTYP:=BITFLD|08000; STORTYP() ...0) ...if were in bitfield, pad to end end if R1:=@R8[SDSZ]=0 then begin ZSZSTR~ Errm(); DEFT '0 SIZE IN () do begin ... ASCtoN(RL0:); RL0:->RL1; RH1:=0 ... R3:*16+R1 ... end ... POP LASTDE; R3==R3; RET ... [ABC] => CALL Latch;WORD ABC ... Latch is a call allowing undefined symbols ...Latch: PROC ... R3:=@(@R15) ...R3=^ABC ...Latch2: R3==1; JP NZ,@R3 ....check for /DIAG output Putcon(); Put1(RL0:=';') end LDB @R7,#' ' ...put space at end of stuff in buffer R3:=^BUFF; CALL CODEGEN ... RL0:=@(R3:=^BUFF); R3:+1 ...get first char ... if RL0='=' then begin ...check for assembler type ... R1:=NEXTDElast 2) LDL RR0,RR8 if BIT R1,0 zero then SRL R1 PUTLDCON(RL3,2) ...also passes RR0 RH3:=XLATREG(RL7) R2:=0BA01; if BIT R9,0 zero then R2:=0BB01 RL2:|(RL6:*010); RL3:=RH6*010 WRCDL() RELREG_() restore R6..R9 RET PTRADDSUB: ...enter with RL3=desOuthex(RL0:=RL3); POP R0; RET OutADR: ...print addr in RR2 (incl. seg.) RL0:=RH2&0F+'0'; if RL0>'9' then RL0:+7 RL0:->@R7' RL0:='.'->@R7' ...fall thru: HLout(); RET OutSP: LDB @R7,#' '; R7:+1; RET ...TABLE ENTRY FORMAT OF SYMBOLS (byte pos. from beSTRUCT ' end if R1+(ALSTRUCT-1)&(-ALSTRUCT)<>R1 then begin CURTYP:=0; STORTYP() end DCLLVL:-1 R1:=AGGDCL0[DCLLVL]; RESB SDFLG[R1],INDEFB restore R8 RET DCLMOSU: ...declare member of structure or union ...enter with CURTYP,CURAGG set, Id on STAC& .if R3<>1, jump to routine ... RESFLG Z; RET ...COPY routines: output to @R7 with R7 updated Icopy: PROC Outset() Copy: PROC ...DEFT to copy follows call R3<->stk; PUSH R1 RL1:=@R3; RH1:=0 ...get count R3:+1; LDIRB @R7,@R3,R1 POP R1; R3:+1; RES R3,0; PUSH R1 ...save source ptr ... CLRB @R7; R7:+1 ...put 0 at end to stop parsing ... R1:=FREE; PUSH R1 ...save stack top ... SAVX() ...save INSTLIST (@HL--DE) in user stack ... POP R7 ...recall start of INSTLIST in stack ... CALL INSTLIST .NHASH: EQU 32 ...BUFSZ~ EQU 0C00 ...size of local buffer pool SYMPTR: WORD 0 ...gets ^symtab entry after Lkup NXTSNUM: WORD 0 ...next symbol no. NS_TAB: WORD 0 ...logical table to use for NXTSYM_ (covers bits MACB,TAGMB) ...(make byte if SFLAGS made g. of entry): HIVAL: EQU 0 ...value of symbol LOVAL: EQU 2 LINK: EQU 4 ...link : 2 bytes TYPE: EQU 6 AGGPTR: EQU 8 SCLASS: EQU 10 SLEVEL: EQU 11 SFLAGS: EQU 12 ...for now, consider a word including SAUX SAUX: EQU 13 ...need? SNUM: EQU 14 ...symbol numbeK STORTYP()->R3; R2:=0 ...RR2=offset DCLSYM0() RET CKMOS: ...check if SC=MOS SCDCL[DCLLVL]&BSCMASK==MOS; RET DCLBITF: ...declare bit field ...enter with field size & Id on STACK if R0:=CURTYP<>INT and R0<>UINT then WRGTYP() ReK()->R3 ...get fiel; R3<->stk RET Copyin: PROC ...copies from LASTDE to NEXTDE R1:=NEXTDE-(R3:=LASTDE) LDIRB @R7,@R3,R1 RET Del: PROC if RL0:=@R7<>' ' then begin RL0==' '; RET NZ end repeat RL0:=@(R7:+1) until RL0<>' ' and RL0<>' '; RL0==RL0; RET ...String: if RL0:..go parse statement ... POP R7 ...recall NEXTDE ... Ig() ...pop text from stack ... RL0:-RL0; RET ...1->Z ... end ... R1:=R7 ... PUSH R6 ... LDL RR6,NCDSEG ...R6:=NCDSEG; R7:=NCODE ... if RL0=''' then begin ...string type ... repeat WRaDEi(RLbyte) NS_LINK: WORD 0 ...current link for NXTSYM_ NSOPTR: WORD 0 ...current ptr for NXTSYMO OUTSW: BYTE 0 ...if=1, Out not done C_OP~ BYTE 0 ...operator in Calc PTRSZ: WORD 0 ...size of obj. pointed to (from POPN) PTRSZ1~ WORD 0 ...used by Calc PTRSZr passed to CODEGEN LNGTH: EQU 16 ...length of symbol name (Lkup assumes LNGTH=even) NAME: EQU 17 ...start pos. of name ...low nibble of TYPE word (symbol type): CHAR: EQU 2 SHORT: EQU 3 INT: EQU 4 LONGT: EQU 5 FLOAT: EQU 6 DOUBLE: EQU 7 STRT: EQU 8 UNIOd size RH1:=RL3; RL1:=BITFLD; R1:->CURTYP STORTYP()->R3 ...rets. R3=offset, RL5=bit offset RH2:=RL5; RL2:=0 DCLSYM0() RET PADFLD: ...enter with size of field to pad on STACK ReK()->R3 RH1:=RL3; RL1:=BITFLD; R1:|08000->CURTYP STORTYP() R0==R0; RE=@R7<>''' then begin RL0=='"'; RET NZ end ... R7:+1; RL0:->RL1; JR SR2 ...SRBEG: CPB @R7,#'"'; RET NZ; R7:+1 ...Sr: PROC ...advance DE until @DE=quote, starting at DE+1 ... RL1:='"' ...SR2~ SRDO(RH1:=80) ...max count=80 ... RET Z TULONG: Errm(); DEFT 'T0:=@R3) until R3:+1=R1; ... R7:->NCODE; JR OUTDUN ... end ... OUTCP() ... R7:->NCODE ... POP R6 ... R3:-1; PUSH R1 ... repeat PUSH R3; RL0:=@R3; R3:+1 ... OUTCP() ...go handle data in buffer (RL0=1st char., R3 at 2nd) ... R7:->NCODE ...new NCODE ..2~ WORD 0 ...BUFFER: DEFS BUFSZ Test: PROC ...enter with DE->data; ret. addr.->DEFT 'STR' to compare against ...returns Z=1 if found, DE->next char., LASTDE=old DE ...saves other regs>R3 POP R3 R1:=@R3 if RL1<>@R7 then begin ...test 1st char. RNT: EQU 9 BITFLD: EQU 12 USHORT: EQU 13 ...all unsigned & corres. signed types differ by UINT-INT UINT: EQU 14 ULONG: EQU 15 ...type modifiers: PTR: EQU 010 FTN: EQU 020 ARY: EQU 030 ... TMASK: EQU 030 BTMASK: EQU 0F ...values of SCLASS: AUTO: EQU 1 EXTE...routines to interface with floating pt. package ...floating pt. format: ffffffee, high bit of ffffff=sign, ee=excess 128 ...system calls Asctoflt~ EQU 050 ...converts string @RR2 to floating pt. number in RR2 CnvFlt: EQU 04D CnvInt: EQU 04E FAdd: EQU OO LONG'; BYTE 0 ...SRDO~ ...enter with RL1=end str. char; RH1=max. count ... R7:->LASTDE; RL0:=@R7 ... repeat RL0==0D; JR Z,TULONG; R7:+1; RL0:=@R7==RL1; RET Z ... until RH1:-1 zero; ... ...note: above must be DJNZ ... RET ...Sr1: PROC ...testing for . POP R3; R1:=@R15 ... R1:-R3; JR Z,OUTX ...get remaining len. of data ... R6:=NCDSEG ... RL0:=','; CPIRB RL0,@R3,R1,EQ ... until not zero; ...if "," in remaining data, repeat starting after it ...OUTX~ POP R1 OUTDUN: R7:=NEXTDE R0==R0; RET ...H1:->RL1-RH1; R3:+R1; RES R3,0; JP 2(R3) ...test failed end R2:=R7; R7:+1 if RH1:-1 zero then begin R2:->LASTDE; JP 2(R3) end ...if only 1 char. R3+2; RH1:->RL1-RH1 CPSIRB @R7,@R3,R1,NZ ...test rem. chars. if not zero then begin R2:->LASTDE; R3RN: EQU 2 STATIC: EQU 3 REGISTER: EQU 4 EXTDEF: EQU 5 LABEL: EQU 6 ULABEL: EQU 7 MOS: EQU 8 STNAME: EQU 10 MOU: EQU 11 UNAME: EQU 12 TYPEDEF: EQU 13 MOE: EQU 14 CONST: EQU 16 ...here & below used in exprs. INDR: EQU 17 ...indirect ACC: EQU 18 ...value i048 FSub: EQU 049 FMult: EQU 04A FDiv: EQU 04B FCmp: EQU 04C ASCFLT: ...enter with R3=^ascii string containing floating pt. const. ...ret. RR2=internal floating pt. form, Z=1 =>can do R2:=0FFFF; SC Asctoflt; R0==R0; RET CNVFLT: ...enter with RR2=integeexactly one byte not " ... SRDO(RL1:='"'; RH1:=1); RET Z ... R7:-1; RESFLG Z; RET Cnt: PROC ...inserts count byte into output R3:=NEXTDE-LASTDE RL3:->@R7' RET ...SPCMA~ ...check if @HL=' ' or ',' ... RL0:=@R3==' '; RET Z; RL0==','; RET Inhex: PROC .OUTCP: RET ...RDFERR: Errm(); DEFT 'REDEFINED LABEL' ...GETSCP: ...get scope->RL0 ... RL0:=(@R13[SFLAGS]&0C0)/040; RET ...SETSCP: ...set scope (high 2 bits) of type word to RL0 ... RH0:=@R13[SFLAGS]&03F; RL0:*040; JR SETCS2 ... ...SETCHTYP: ...set chain:+1; RES R3,0; R3==R3; JP @R3 ...succeed end R7:=R2; R3:+R1+1; RES R3,0; JP @R3 ...fail ...XLAT~ DEFM ' :;<=>?' ... 0 - 9 ... DEFM '@ ' ... A - O ... DEFM ' [\]^ ' ... P - Z and _ ... DEFM '` ' ... a - o n acc. PTREXT: EQU 19 PTRAUTO: EQU 20 TLABEL: EQU 21 FLABEL: EQU 22 STATICB: EQU 7 ...set if MOS,MOU,STNAME,UNAME of static agg. BSCMASK: EQU 07F ...masks off STATICB ...bits of SFLAGS word: UNDEFB: EQU 4 ...=1 if undefined REFB: EQU 5 ...=1 if definedr to convert to float format SC CnvFlt; RET ...float operations FLTNEG: ...RR2=-RR2 R2:.XOR.08000; RET ...invert sign bit FLTADD: ...RR2+=RR4 SC FAdd; RET FLTSUB: ...RR2-=RR4 SC FSub; RET FLTMULT: ...RR2*=RR4 SC FMult; RET FLTDIV: ...RR2/=RR4 S..convert 2 hex digits @R3 to value in RL0, inc. R3 if RH0:=@R3>='A' then RH0:-7 RH0:*010 if RL0:=@(R3:+1)>='A' then RL0:-7 RL0:&0F|RH0 R3:+1; RET ... PUSH R1 ... ASCtoN(RL0:=@R3); RL0:*16->RL1 ...high nibble ... ASCtoN(RL0:=@(R3:+1)); RL0:|RL1 ... R'  type (bits 8-10) in type word to RL0 ... RH0:=@R13[SFLAGS]&0F8 SETCS2~ RH0:|RL0->@R13[SFLAGS]; R0==R0; RET ...ret Z=1 ...GETCHTYP: ...get chain type->RL0 ... RL0:=@R13[SFLAGS]&7; RET ...SETTYP: ...set lower nibble of type word to RL0 ... R0:->@R13[TYPE2...)); ret. R3 at pos. for 1st entry R3:=TABBSE; R1:=2*NHASH+2->@R3; R1:-2 TBINT2~ R3:+2; RL0:=0; repeat RL0:->@R3' until R1:-1 zero; R0==R0; RET TABLEN~ ...enter with DE at end of symbols; store rel. len. of table @2TABBSE R3:=TABBSE; R7:-R3->@R3; RE R2:=0; ADDL RR2,CDPTR if RL2<>0 then begin Errm(); DEFT 'CODE: SEGMENT OVERFLOW ' end LDL CDPTR,RR2 RET INCBSSPTR: ...BSSPTR:+RR2 ADDL RR2,BSSPTR if RL2<>0 then begin Errm(); DEFT 'DATA: SEGMENT OVERFLOW ' end LDL BSSPTR,RR2 RET ...routifound, CARRY=1 if referenced & not defined ... RR6 unchanged PUSHL RR6; PUSHL RR8; PUSH R10 R6:=R3; R8:=R5&1; R9:=R5&TABMSK ...R8=LINKSW, R9=which of 3 tables R10:=0 ...may get set to zapped symbol entry of same len R5:=R7-R3 ...R5=length of syLINK; ret Z=0 if done, else Z=1, R13=^entry ...also ignore zapped entries R13:=NS_LINK repeat R0:=@R13[LINK]==0; COMFLG Z; RET NZ R13:+R0 until BIT SFLAGS[R13],ZAPB zero and @R13[SFLAGS]&TABMSK=NS_TAB; R13:->NS_LINK; RET NXTSYMO0: PROC ...init.]; RET ... PUSH R1; R1:=@R13[TYPE]&0FFF0; RL1:|RL0; R1:->@R13[TYPE]; POP R1 ... RET ...GETTYP: ...get lower nibble of type word->RL0 ... R0:=@R13[TYPE]; RET ... RL0:=@R13[TYPE+1]&0F; RET ...below preserve regs: SETVAL: LDL HIVAL[R13],RR2; RET ...RR2->symT ...PAKALL: PROC RL0:=1; JR PK1 PACK: PROC ...pack symbol table ... RL0:=0 ...PK1~ RL0:->PAKSW PUSH R7; PUSH R11 R1:=2*NHASH; TBINT2(R3:=TABBSE) ...zero init. links, get R3=^1st symbol R3->R13->R11 ...R13 pts. at old table, R11 at new JR PK2 PKLUP~nes to translate between host & target machine addresses (in RR2): XLCDADR: PROC ...xlate host code addr->target code addr R1:=REGNNO*4 SUBL RR2,CDBAS[R1]; ADDL RR2,CDBAS_T[R1] RET UXLCDADR: PROC ...target code addr->host code addr R1:=REGNNO*4 SUmbol RL2:=@R3 ...RL2=1st char HASHER(RL0:=RL5) ...get R3=^init. link R3->R4 ...save it R3-LINK->R13 ...pt. to appropriate base link-LINK RH2:=RL5 ...len LKLUP: repeat R7:=@R13[LINK] R7==0; JR Z,LKEND ...end chain R13:+R7 until R2=@R13[LNG for NXTSYMO NSOPTR:=TABBSE+(2+NHASH*2); RET NXTSYMO: ...get ^next symbol in order of occurrence (not zapped) ->R3 ...ret. Z=0 when to end else Z=1 PUSH R13 R13:=NSOPTR repeat if TSTEND() >=zero then begin RESFLG Z; JR NSOX end RL1:=@R13[LNGTH]bol value GETVAL: LDL RR2,HIVAL[R13]; RET ...symbol value->RR2 MRKREF: RES SFLAGS[R13],REFB; RET ...mark symbol referenced ...GETSNUM: R3:=@R13[SNUM]; RET ...CKABADRT: R0==R0; RET NDFERR: CALL Errm; DEFT 'NOT DEFINED' LKUPA~ if NCDFLG<>0 and RL0:=@R3> R13:+R1 PK2~ while TSTEND() R1 if BIT SFLAGS[R13],UNDEFB zero then begin ...save undef'd symbols Tstsym(); JR NZ,PKLUP ...skip iBL RR2,CDBAS_T[R1]; ADDL RR2,CDBAS[R1] RET XLBSSADR: PROC ...host bss addr->target bss addr UXLBSSADR: PROC ...target bss addr->host bss addr RET RGNINIT: PROC ...init REGNNO; set CDBAS,CDBAS_T,BSSBAS,BSSBAS_T from CDPTR,etc XLCDADR(LDL RR2,CDPTR)TH]; ...chks len. & 1st char. ...NOTE: above assumes LNGTH even if BIT SFLAGS[R13],ZAPB not zero then begin ...check if zapped R10:=R13; JR LKLUP ...spot can be reused end R3:=R13+(NAME+1) ...pt. R3 to name+1 R7:=R6 ...source starting char. +(NAME+1); RH1:=0; RES R1,0 R3:=R13; R13:+R1 ...pt. R13 to next symbol until BIT SFLAGS[R3],ZAPB zero; ...Z=1 R13:->NSOPTR NSOX~ POP R13; RET NXTXSYM: ...get ^next extdef/extern symbol, Z=0=>done; precede with NXTSYMO0 repeat R3:=NXTSYMO(); RET NZ ='A' then begin ...LKUPe~ S_LKUPNL(); JR NZ,NDFERR; JR C,NDFERR; RET ...if imm. ex. then symbol (exc. tmp.) must be defined end S_LKUP(); RET ...ret. R5,R13 ...RESEXTSB: PROC ...reset EXTEND (symbol "EXTEND" @LASTDE..R7) ... Lkup(R3:=LASTDE); Rf masked out ... if PAKSW=0 then begin ...chk if packing just globals ... GETSCP(); RL0==GLOBSC; JR NZ,PKLUP ...skip if not global ... end end BIT SFLAGS[R13],ZAPB; JR NZ,PKLUP ...skip if zapped RL0:=@R13[LNGTH]; R3:=R13+NAME ...; LDL CDBAS_T,RR2 ...actually CDBAS_T[0] ...must do XLCDADR before change CDBAS/CDBAS_T LDL RR2,CDPTR; LDL CDBAS,RR2 XLBSSADR(LDL RR2,BSSPTR); LDL BSSBAS_T,RR2 LDL RR2,BSSPTR; LDL BSSBAS,RR2 REGNNO:=0; REGNNO_B:=0 R0==R0; RET ORGI: ...init. NEWCDR1:=R5 if R1:-1 not zero then begin R7:+1 CPSIRB @R7,@R3,R1,NZ; JR Z,LKLUP end ... BIT SFLAGS[R13],ZAPB ...check if zapped ... JR NZ,LKFIN @R13[SFLAGS]&TABMSK==R9; JR NZ,LKLUP ...chk right logical table BIT SFLAGS[R13],HIDDENB; JR NZ,LKLUP ...c until RL0:=@R3[SCLASS]=EXTDEF or RL0=EXTERN; RET ...Z=1 Nm00~ BYTE 0 ...min. symbol alphabetically NmFF~ BYTE 0FF ...max. symbol Map: PROC ...prints out symbols and values PUSH R7; Nxtpos:=^BUFF if MAPTYP<>'A' then begin ...do by order of occurre1:=^EXTADR->@R13[LOVAL] ... LD SFLAGS[R13],2**UNDEFB; SETCHTYP(RL0:=ABSCH) ... LD @R1,#1; R0==R0; RET S_LKUPNL: PROC R5:=1; JR S_LKUP_ ...don't add to symbol table if not found ... S_LKUP: PROC R5:=0 S_LKUP_~ ...expects R3 pointing to data ending with for HASHER R2:=R11 LDIRB @R11,@R13,R1 ...move old entry to new table HASHER() ...base of table + HASH = 1st link -> R3 R2:<->R13 LINKER() ...link @R3->here; here->prev. link @R3 (R13=^new entry) R13:=R2 end TABLEN(R7:=R11) ...store ORG,NEWBSSORG to 0 SUBL RR2,RR2; LDL NEWCDORG,RR2; LDL NEWBSSORG,RR2; RET ... ST..s below entered with addr for orging on STACK STCDORG: ReV(); LDL NEWCDORG,RR2 UXLCDADR(); LDL NEWCDPOS,RR2 R0==R0; RET STCDAT: ReV(); LDL NEWCDPOS,RR2; R0==R0; RET Shk not hidden BIT SFLAGS[R13],UNDEFB ...Z=1 if symbol defined JR Z,LKEXIT0 ...OK, Z=1,C=0 SETFLG Z,C ...prev. ref: Z=1,C=1 JR LKEXIT LKEND: R8==0; JR NZ,LKEXIT0 ...if don't want linked up (Z=0, C=0) R13:=R10 if R10=0 then begin R3:=TABBSE; R13...following may be moved MAXNREGN: EQU 6 ...max no. of physical code or data regions for compile CDORG0: ADDR CDPTR0 ...starting code origin of target machine BSSORG0: ADDR BSSPTR0 ...ditto bss REGNNO: WORD 0 ...region no.: index for below (init'd ina ' ' or ',' ... R5=0 if to add symbol to table if not found, else=1 ...returns R3,R13 pointing to table entry ...Z=1 if found, CARRY=1 if referenced & not defined ...RR6 unchanged; ...R5=orig. R3 PUSH R7 R3->R7; ...PUSH R3 RH1:=080 ...limit to sea' len. of new table at TABBSE POP R11; POP R7; R0==R0; RET Nxtsym: PROC ...steps through symbol table by hash codes and links ...if RL0=0 then returns first symbol first chain, else returns next ... symbol same chain (then next chain) ...returns Z=1, R3TBSSORG: ReV(); LDL NEWBSSORG,RR2 UXLBSSADR(); LDL NEWBSSPOS,RR2 R0==R0; RET SETNEWORG: ...have NEWCDPOS,etc; set new REGNNO,CDBAS,CDPTR,CDBAS_T, old ... LCDREGN, also BSSBAS,etc save R7..R9 if NEWCDORG<>0 then begin R7:=REGNNO*4 ...RR8=CDLEN,:=R3+@R3 ...next free loc.->R13 R3:=R13+NAME+R5 ...new end of symbol table R3==ENDTAB ...test if room left in symbol table for new entry JR UGT,TUMANY ...too many symbols RL5:->@R13[LNGTH] ...length of symbol name end R7:=R13+NAME ...R6=^ RGNINIT) REGNNO_B: WORD 0 ...region no. for bss regions CDBAS: LONG CDPTR0 0[MAXNREGN-1] ...base of code section (host) CDBAS_T: LONG CDORG0 0[MAXNREGN-1] ...if target diff, init. with target addr LCDREGN: LONG 0[MAXNREGN] BSSBAS: LONG BSSPTR0 0[MAXNRErch repeat RL0:=@R7==' '; JR Z,S_LK2; RL0==','; JR Z,S_LK2; R7:+1 until RH1:-1 zero; ...R7 points to ' ' or ',' S_LK2~ Lkup_() ...POP R5 POP R7; RET MAKSNUM: PROC ...get unique number for symbol R3:=NXTSNUM; NXTSNUM:+1; RET LINKER~ ...expects : R3,R13 at symbol tbl entry if found; Z=0 if at end ...preserves regs<>R0,R3 PUSH R1 if RL0=0 then begin RL0:->Hash; R3:=TABBSE+2 end else R3:=Link while begin ...get ptr. to link of next entry (R3+@R3->Link): R1:=@R3 R3+R1->Link; R1==0 ...Z=1 if RR10=BSSLEN LDL RR8,CDPTR; SUBL RR8,CDBAS[R7] ...CDLEN:=CDPTR-CDBAS[REGNNO] if TESTL RR8 not zero then begin if REGNNO>=(MAXNREGN-1) then begin TUMNYRG~ Errm(); DEFT 'TOO MANY REGIONS ' end LDL LCDREGN[R7],RR8 ...LCDREGN[REGNNO]:=CDstart of source symbol; R5=len. LDIRB @R7,@R6,R5 ...symbol name in table (R7->new end of symbols) if R10=0 then begin if BIT R7,0 not zero then B.0->@R7' ...R7:+1; RES R7,0 ...to even boundary TABLEN() ...store rel. len. of table at TABBSE GN-1] ...base of bss section of region (host) BSSBAS_T: LONG BSSORG0 0[MAXNREGN-1] ...target LBSSREGN: LONG 0[MAXNREGN] NEWCDPOS: LONG 0 NEWCDORG: LONG 0 NEWBSSPOS: LONG 0 NEWBSSORG: LONG 0 RGNCNT: WORD 0 RELOSW: BYTE 0 ...bit 1 set if don't want symt at base link; R13 at new entry ...performs: if @R3=0, 0->@R13[LINK] else @R3-[R13+LINK-R3]->@R13[LINK] ... [R13+LINK-R3]->@R3 ...returns : R13 unchanged R1:=@R3 R7:=R13+LINK-R3->@R3 if R1<>0 then R1:-R7 R1:->@R13[LINK] RET HASHER~ PROC ...gef end of chain (@R3=0) end zero do begin if RL0:=Hash+1=NHASH then begin RESFLG Z; JR NxtsymX end RL0:->Hash; RL0:*2+2; RH0:=0 R3:=TABBSE+R0 ...ptr. to next base link end R3:-LINK->R13 R3==R3 NxtsymX~ POP R1; RET Tstsym~ PROC ...tests symboLEN REGNNO:+1; R7:+4 end LDL RR2,NEWCDPOS; LDL CDBAS[R7],RR2 ...CDBAS[REGNNO]:=NEWCDPOS SETCDPTR() LDL RR2,NEWCDORG; LDL CDBAS_T[R7],RR2 ...CDBAS_T[REGNNO]:=NEWCDORG end if NEWBSSORG<>0 then begin R7:=REGNNO_B*4 ...RR8=BSSLEN  R3:=R4 ...base link LINKER() ...link up (R13 at new table entry) end ...LKFIN~ R8==0; JR NZ,LKEXIT0 ...chk LINKSW; Z=0, C=0 SUBL RR0,RR0; LDL @R13,RR0 ...0->HI,LOVAL R0:->@R13[TYPE]->@R13[AGGPTR] RL0:->@R13[SCLASS]->@R13[SLEVEL] ...0->other sab+relo info in image BYTE 0 MAGIC1: EQU 0E007 ...segmented executable/relocatable HDRSZ: EQU 24 ...bit of HDRFLGS: NORELOB: EQU 0 ...no reloc. info or symtab SGENTSZ: EQU 8 ...size of segtab entry ...segtab offsets: SG_ADDR: EQU 0 SG_LEN: EQU 4 SG_Tnerates hash code for lookup table ...expects RL0 with symbol length; symbol @R3 ...returns code*2+2 in R7, init. link in R3 RL0:-1; RL0:=@R3 if not zero then RL0:*4.XOR.@(R3:+1) RL0:&(NHASH-1) RL7:=(RL0+1)*2; RH7:=0; R3:=TABBSE+R7; RET Lkupnl_M: PRl @R13 to see if not masked out (save regs<>0) ...chk MAPCMP, MAPMSK, MAPBEG & MAPEND if R0:=MAPCMP.XOR.@R13[SFLAGS] & MAPMSK zero then begin if MAPBEG<>0 or MAPEND<>0FFFF then begin PUSH R1; PUSHL RR2; PUSHL RR4 if CKEXTTYP(R13) then R3:=GELDL RR8,BSSPTR; SUBL RR8,BSSBAS[R7]...BSSLEN:=BSSPTR-BSSBAS[REGNNO_B] if TESTL RR8 not zero then begin if REGNNO_B>=(MAXNREGN-1) then TUMNYRG() LDL LBSSREGN[R7],RR8 ...LBSSREGN[REGNNO_B]:=BSSLEN REGNNO_B:+1; R7:+4 end LDL RR2,NEWBStuff R0:|R9->@R13[SFLAGS] ...SFLAGS=0 + log. table flag MAKSNUM()->@R13[SNUM] RESFLG Z ...set Z=0,C=0 LKEXIT0~ RESFLG C LKEXIT: R13->R3->SYMPTR POP R10; POPL RR8; POPL RR6 ...R7 after source symbol RET TUMANY: CALL Errm; DEFT 'TOO MANY SYMBOLS'; BYYP: EQU 6 SN_ENTSZ: EQU 14 ...size of symtab entry (as goes in image file) SHORTNM: EQU 9 ...symtab offsets: SN_VAL: EQU 0 SN_TYP: EQU 4 SN_NAME: EQU 5 SYMTBBF: BYTE 0[SN_NAME+1] ...used by PUTSYMTB NULBUF: BYTE 0[SN_ENTSZ-1] ...ditto (init'd) BYTE 0OC ...lookup macro symbol R5:=MACRO|1; JR LKUP_ Lkup_M: PROC R5:=MACRO; JR LKUP_ ... Lkupnl_T: PROC ...lookup tag/member symbol R5:=TAGM|1; JR LKUP_ Lkup_T: PROC R5:=TAGM; JR LKUP_ ... Lkupnl: PROC ...Lkup but don't link in symbol if not found R5:=1TSYMADR(R13) else R3:=GETVAL() if R3<=MAPEND and R3>=MAPBEG then R0==R0 POPL RR4; POPL RR2; POP R1 end end RET NXTsym: PROC ...get R13 pointing to next symbol not masked out repeat Nxtsym(); RET NZ until begin Tstsym(); RL0:=1 end; RSPOS; LDL BSSBAS[R7],RR2 LDL BSSPTR,RR2 LDL RR2,NEWBSSORG; LDL BSSBAS_T[R7],RR2 end restore R7..R9 R0==R0; RET SETIMGDFT: PROC ...set default entry pt. & clear RELOSW RELOSW:=0 SET_E2(LDL RR2,#0FFFF,0FFFF) RET SETSTRPD: PROC; SETB RELOSW,1; RTE 0 TSTEND~ ...performs R13==(W.TABBSE+@2W.TABBSE) ...returns R1->end of symbols (ENDSYM); preserves regs<>R1,R3 R3:=TABBSE; R1:=@R3+R3 R13==R1; RET TABINT: ...set 1st 2 bytes @R3 = rel. disp. to init. table end position ...0's -> init. links (@(R3+ SETCDPTR: PROC ...enter with RR2=addr to set CDPTR to (without doing FIXAREFS) LDL CDPTR,RR2; LDL LSTNCDL,RR2 CALL AREFTABI ...init AREFPTR,FCDPOS RET ...host & target machine dep: ...can check for overflow of region/segment INCCDPTR: ...CDPTR:+R3; JR LKUP_ Lkup: PROC R5:=0 Lkup_~ LKUP_~ ...expects: R3 pointing to first source character ... R7 pointing after last source character ... R5=0 iff to add symbol to table if not found ...returns: R3,R13 pointing to table entry ... Z=1 if ET NXTSYM_0: PROC ...init. for NXTSYM_ of symbol in entry @R3 R1:=R3 @R1[SFLAGS]&TABMSK->NS_TAB PUSH R7 HASHER(RL0:=@R1[LNGTH]; R3:=R1+NAME)-LINK->NS_LINK POP R7; RET NXTSYM_: PROC ...get next symbol entry which matches NS_TAB starting from ... NS_( 0==R0; RET ...mark to use stripped format SET_E: PROC ...for IMAGE: recall entry pt. from STACK & set vars. ... SETB RELOSW,0 ...mark to use proc. header format ReV() SET_E2~ LDL ENTRYPT,RR2 ... R2:->E_SEG; EXB RL3,RH3; R3:->E_ADD R0==R0; RET IMGSUB R0<>0 then begin R3:=^NULBUF; R7:=R3+R0 PUTFILE(R3; R7:) end end PUTOUT() ...flush buffer restore R6..R8 RET SHWRGNS: PROC ...print out showing regions ...note: Outmsg doesn't restore R7 of before Outset PUSH R7 ST_RGNI() ...sets lthen begin ...word mult RL3:=CNVTACC_(RL6,'4') RL2:=XLATREG(RL3) RH2:=019; R3:=R9 WRCDL() end else begin ...long mult MLTD0(RL6,B.0FF) WRCDW(01800); WRCDL(LDL RR2,RR8) ...MULTL RQ0,#K MLTD2(RL6,B.0) ...0=RR2 end :=SN_ENTSZ else R0:=(R0+(SN_NAME+1+SN_ENTSZ-1))/SN_ENTSZ*SN_ENTSZ R0:+SYMTBSZ->SYMTBSZ end RELOCSZ:=RELOTBX POP RELOTBX RET STCDRGN: ...for code region no. R3, if len<>0, fill in segtab (index SEGTBSZ), ... adjust IMGSZ,SEGTBSZ R3:*4 LDL RR0,4; RL3:=RH6*010+RL6 end WRCDW(R3) restore R6 RET PUTCOMPL: ...enter with RL3=reg., RL5=size/type char ('2'/'4') ...do complement (ignore if float) save R6 RH6:=RL5 if RH6<>'d' then begin RL3:=XLATREG(RL3) RL3:*010->RL6 RH3:=08D WRCDW(R: PROC ...do IMAGE, filename @^FILNM, ENTRYPT=entry pt ...add header ...if bit RELOSW,1 =0, also add reloc info,symtab ST_RGNS() ... if RELOSW=0 then begin ... OPNIMGFIL() ... PUTIMG() ... end else begin HDRINIT() ...init stuff in header if Bength of last regions Outset(); Copy(); DEFT 'CODE:'; Outmsg() SHCDRGNS() Outset(); Copy(); DEFT 'DATA:'; Outmsg() SHBSSRGNS() POP R7 R0==R0; RET SHCDRGNS: PROC ...go thru all code regions & print target & ncode addrs & len save R8..R11 R8:=0 re end restore R6..R9 RET PUTDIVK: ...enter RL3=reg., R5=size/signed chars for result, RR0=const. to ... divide by MODFLG:=0 PUTMDK2: ...enter here with MODFLG set save R6..R9 RL6:=RL3; R7:=R5; LDL RR8,RR0 if CPL RR8,#1 not zero then begin if RL7=LCDREGN[R3] if TESTL RR0 not zero then begin LDL RR2,CDBAS_T[R3] LDL RR4,RR0; ADDL RR0,IMGSZ; LDL IMGSZ,RR0 STSEGTB(R1:=0) end RET STBSSRGN: ...for bss region no. R3, if len<>0, fill in segtab (index SEGTBSZ), ... adjust BSSSZ,SEGTBSZ R3:*4 3) if RH6>'2' then begin RH3:=08D; RL3:=RL6+010 WRCDW(R3) end end restore R6 RET ...PUTNOT: ...enter with RL3=reg., RL5=size/type char for result, RL1=init. size/ ... ... type (may include '1'); do logical not (for now, ignore float) ..ITB RELOSW,1 zero then begin CKRELOINF() ...chk have ok relo info CNTSYMS() ...count #syms+put in relo info for undf'd syms ...do before open in case out-of-space error with relo info end OPNIMGFIL() ...open image file & set attributespeat R9:=R8*4 Outset() LDL RR10,CDBAS_T[R9] OutADR(LDL RR2,RR10) LDL RR2,CDBAS[R9] if CPL RR2,RR10 <> zero then begin Copy(); DEFT ' AT '; BYTE 0 ...preserves RR2 OutADR() end OUTLEN(LDL RR2,LCDREGN[R9]) Outmsg() unti'u' and ISPWR2(LDL RR2,RR8)->R1 then begin if MODFLG=0 then PUTSHFT(RL6,R7,-R1) else PUTANDK(RL3:=RL6; RL5:=RH7; LDL RR0,RR8; SUBL RR0,#1) end else if R7='2'*0100+'s' then begin ...signed word div. PUTEXT(RL6,'4'*0100+'s','2'*0100+'s')  LDL RR0,LBSSREGN[R3] if TESTL RR0 not zero then begin LDL RR2,BSSBAS_T[R3] LDL RR4,RR0; ADDL RR0,BSSSZ; LDL BSSSZ,RR0 STSEGTB(R1:=1) end RET STSEGTB: ...enter with RR2=addr, RR4=len, R1=type to go in segtab ... (index=SEGTBSZ); put in & upda. save R6,R7 ... RL7:=RL3; RH6:=RL5 ... PUTTEST(RL3,RL1) ... RL6:=GETCCD(B.'=',B.'s') ... RL3:=CNVTACC_(RL7,RH6) ...convert acc to dest. size ... PUTTCC(RL3,RH6,RL6) ... restore R6,R7 ... RET PUTTEST: ...enter with RL3=reg., RL5=size/type char (may be '1 PUTHDR() ...put out header+segtab PUTIMG() if BITB RELOSW,1 zero then begin PUTRELOC() ...put out reloc. info PUTSYMTB() ...put out symtab+string tab end ... end CLSIMGFIL() RET HDRINIT: ...clear header except set MGKNO,E_PT,HDl R8:+1>REGNNO; restore R8..R11 RET SHBSSRGNS: PROC ...go thru all code regions & print target & ncode addrs & len save R8,R9 R8:=0 repeat R9:=R8*4 Outset() OutADR(LDL RR2,BSSBAS[R9]) OUTLEN(LDL RR2,LBSSREGN[R9]) Outmsg() until R8:+1 RL3:=CNVTACC_(RL6,'4') RL2:=XLATREG(RL3); RH2:=01B; R3:=R9 WRCDL() if MODFLG<>0 then begin RL3:=XLATREG(RL6)->RL0; RL3:=(RL3-1)*010+RL0 RH3:=0A1; WRCDW(R3) end end else begin if R7='2'*0100+'u' then begin ...ute SEGTBSZ R0:=R1 R1:=^SEGTAB+SEGTBSZ LDL R1[SG_ADDR],RR2; R5:->@R1[SG_LEN] ...LDL R1[SG_LEN],RR4 R0:->@R1[SG_TYP] SEGTBSZ:+SGENTSZ RET PUTHDR: ...write out header & segtab to image file ...1st fill in segtab+SEGTBSZ,IMGSZ,BSSSZ (entered set=0, oth','2','4','d') ...put out code to test if 0 save R6 RH6:=RL5 RL3:=XLATREG(RL3); RH3:=085 if RH6='1' then begin RL3:+8; RH3:=084 end RL6:=RL3*010; RL3:+RL6 ...OR Rn,Rn if RH6>'2' then begin R3:=09C08; RL3:|RL6 end ...TESTL RRn ...above includes RFLGS R0:=0; R5:=^MGKNO; R1:=HDRSZ/2 repeat R0:->@R5' until R1:-1 zero; MGKNO:=MAGIC1 LDL RR2,ENTRYPT; LDL E_PT,RR2 if BITB RELOSW,1 not zero then SET HDRFLGS,NORELOB RET ST_RGNI: PROC ...init for ST_RGNs (puts length up to here in last regions) R>REGNNO_B; restore R8,R9 RET OUTLEN~ Copy(); DEFT ' LENGTH='; HLout(R3); RET  GN-1] ...base of code section (host) CDBASR9 R8:=0 repeat R9:=R8*4 Outset() OutADR(LDL RR2,BSSBAS[R9]) OUTLEN(LDL RR2,LBSSREGN[R9]) Outmsg() until R8:+1nsigned word divide RL6:=CONVERT_(RL6,'4'*0100+'s',R7) R8:=0 R7:='4'*0100+'s' end ...long divide: for now, load reg. & call PUTMD3 RL3:=REQREG1_(B.0)->RH6 PUTLDCON(RL3; RL5:=4; LDL RR0,RR8) PUTMD3(RL6,RH6,R7) er entries ... set) save R8 ... MGKNO:=MAGIC1; HDRFLGS:=0; HDRUNUSD:=0 ... ...fill in segtab,imgsz,bsssz,segtbsz: ... SUBL RR2,RR2; LDL IMGSZ,RR2; LDL BSSSZ,RR2 ... SEGTBSZ:=0 R8:=0 repeat STCDRGN(R8) until R8:+1>REGNNO; R8:=0 repeat STBSSRGN(R8) unt'd' WRCDW(R3) restore R6 RET GETCCD: PROC ...enter with RL3=relation op char (=,#,<,>,[,]), RL5='s'/'u' ...ret. RL3=code for cc in inst. ...if RL3 not one of above, ret. always true code case RL3: of '=': RL3:=6 '#': RL3:=0E '<': begin RL3:1:=REGNNO*4 LDL RR2,CDPTR; SUBL RR2,CDBAS[R1]; LDL LCDREGN[R1],RR2 R1:=REGNNO_B*4 LDL RR2,BSSPTR; SUBL RR2,BSSBAS[R1]; LDL LBSSREGN[R1],RR2 ...put length up to here in LCDREGN[REGNNO], LBSSREGN[REGNNO_B] R0==R0; RET ST_RGNS: PROC ...for IMAGE: go (  '>': RL3:='[' '[': RL3:='>' else RL3:='<' end RET OPTIM: ...poss. rewrite code strings GRPKONS(0) ...see if can group constants together COMMTKON(0) ...see if can switch constant to right side BINOPKON(0) ...chk for binary op by const RELO RELREG_() end end restore R6..R9 RET PUTANDK: ...enter with RL3=dest. reg., RL5=size char, RR0=value to `and' with LDL OPVAL,RR0; ADMD:='K'; RL1:=RL5 PUTAND(RL3; RL5:=0FF; RL1:) RET OPREGCD: ...enter with RL3=dest. reg., RL5=source reg.; retil R8:+1>REGNNO_B; PUTO2(R3:=^MGKNO; R2:=QSEG; R1:=HDRSZ+SEGTBSZ) restore R8 RET ...reloc. format: ...long addr; word symbol+type: bit 15=1 =>ext: bit 12=1 if init'n ref, bits ... 0-11=symtab ordinal; bit 15=0 =>local: bit 0=0 =>code ref, =1 =>bss ref =7; if RL5='s' then RL3:=1 end '>': begin RL3:=0B; if RL5='s' then RL3:=0A end '[': begin RL3:=3; if RL5='s' then RL3:=2 end ']': begin RL3:=0F; if RL5='s' then RL3:=9 end else RL3:=8 end RET PUTTCC: ...enter with RL3=reg. to load with 0 or thru all regions & save target & ncode addrs save R8 ST_RGNI() RGNCNT:=0; R8:=0 repeat ST_RGN(R8) until R8:+1>REGNNO; ST_RGNF() restore R8 R0==R0; RET ST_RGN: PROC ...for region no. R3, store info @SegDes,SegSegs,SegSegs2 ... (indexed by RGNCNT);PJP(0) ...chk for compare+jp RET CDGEN: PROC ...enter with R3=^code string in cdstr queue; put out approp. code ...may also use prev. & later code strings in queue (ref ^CDSTRQ,LASTQ) save R8 R8:=R3 OPTIM() R3:=R8 case RL0:=@R3' of 'I': INITLZ. RL3=code for ... lo-byte of operation [s,d] ...if RL3=0FF, set source field=0 save R6 RH6:=RL5 RL6:=XLATREG(RL3) RL3:=0 if RH6<>0FF then RL3:=XLATREG(RH6) RL3:*010+RL6 restore R6 RET ...PUTADD-PUTSHFTDR below entered with RL3=dest. reg., RL5=s PUTRELOC: ...write out relocation data PUTO2(LDL RR2,RELOTB0; R1:=RELOCSZ); RET ...symtab format: ...long value; word type; symbol name padded with 0's, if symbol len>8 then ... 1st byte=len|080 followed by name, padded with 0's to whole entry ...type: 1 depending on whether ... flags agree with cond. code corres. to rel. op char in RL5 & ... sign char in RL1 save R6,R7 RL6:=RL3 RL7:=GETCCD(RL5,RL1) RL3:=XLATREG(RL6) RL3:*010->RH7 RH3:=0BD WRCDW(R3) ...LDK Rn,#0 if RL6&RSZMSK zero then begin  inc. RGNCNT if len<>0 save R8,R9 R9:=R3*4 LDL RR0,LCDREGN[R9] if TESTL RR0 not zero then begin R8:=RGNCNT*4 EXB RL1,RH1; R1:->SegDes[R8+2] LDL RR0,CDBAS_T[R9] EXB RL1,RH1; R1:->SegDes[R8:] EXB RL0,RH0; R0:->SegSegs[RGNCNT*2] LDL RR0,E() 'U': UNINIT() 'L': LOAD() 'l': LABL() 'd': DEFINE() 'Z': ZAP() 'S': STORE() 'F': FORCE() 'B': BEGFORC() 'C': CALLFTN() 'J': JUMP() 's': DECSP() 'r': RESSP() 'E': ENTERFTN() 'X': EXITFTN() 'D': DUPLICATE() ource reg., ... RL1=size/type char; also have ADMD,OPVAL PUTADD: if RL1='d' then PUTFLTOP(RL1:=FAdd) else begin OPCDW:=081; OPCDL:=096 PUTADSB() end RET PUTSUB: if RL1='d' then PUTFLTOP(RL1:=FSub) else begin OPCDW:=083; OPCDL:=092 PUTAD0=undf'd ext., 1=abs. (not used), 2=proc, 3=idata, 4=bss PUTSYMTB: ...write out symbol table ...+ string table ...can use FPUTBF save R6..R8 NXTSYMO0() while R8:=NXTXSYM() do begin RL0:=0 if B.@R8[SCLASS]<>EXTERN then begin RL0:=4 if B...if long RH3:=0BD; RL3:=RH7+010 WRCDW(R3) end RL3:=CNVTACC_(RL6,B.'2'); RL3:=XLATREG(RL3)*010|RL7 RH3:=0AF WRCDW(R3) ...TCC CC,Rn restore R6,R7 RET ISPWR2: ...chk if RR2=power of 2 (exactly 1 bit set); if so, ret. R3=power SUBL RR0,RR0 ..CDBAS[R9] LDL SegSegs2[R8],RR0 RGNCNT:+1 end restore R8,R9 RET ST_RGNF: ...store 0000 after seg. descriptors R1:=RGNCNT*4; SUBL RR2,RR2 LDL SegDes[R1],RR2 R0==R0; RET CKRELOINF: ...chk have ok relocation info if TESTL RELOTB0 zero then begin 'R': REMOVE() '.': FINISH() 'u': UNARYOP() 'b': BINARYOP() 'k': BINYOPK() end INCNXTOUT() restore R8 RET INITLZE: ...put out value in (init'd) data area according to format @R3 save R6..R9 R8:=R3 RL0:=@R8' if RL0='p' then begin ...adSB() end RET PUTCP: if RL1='d' then PUTFLTOP(RL1:=FCmp) else begin OPCDW:=08B; OPCDL:=090 PUTADSBCP() end RET PUTADSB: ...enter with RL3,RL5=dest,src regs, RL1=size char, also ADMD,OPCDW, ... OPCDL,OPVAL; chk if can do inc/dec; if not, do PUIT SFLAGS[R8],CDREGB not zero then begin RL0:=3 if @R8[TYPE]&TMASK=FTN then RL0:=2 end end LDB SYMTBBF+SN_TYP,RL0 if RL0=0 then SUBL RR2,RR2 else GETCGADR(@R8[SNUM]) LDL SYMTBBF+SN_VAL,RR2 R7:=^SYMTBBF+SN_NAME RL6:=@R8[.RL0=RH0=RH1=0 repeat if SRLL RR2 carry then begin RL0:+1; RH0:=RH1 end until RH1:+1=32; RL3:=RH0; RH3:=0 RL0==1; RET PUTMLTK: ...enter RL3=reg., R5=size/signed chars., RR0=const. to mult. by save R6..R9 RL6:=RL3; R7:=R5; LDL RR8,RR0 if CPL RR0, if RELOTBX=0 then begin Errm(); DEFT 'NO MEM. FOR RELOC. TABLE ' end Errm(); DEFT 'LOST RELOC. INFO WHEN TMP. EXITED' end RET CNTSYMS: ...count symtab size+put in relo info for undf'd syms ...enter SYMTBSZ,RELOCSZ=0 ...set SYMTBSZ,RELOCSZ; at edr ref InhexW(R8)->R3; CGLKUP(R3)->R7 InhexO(R8:+4->R3); LDL RR0,RR2 ST_AREF(B.'A',R7) ...also passes RR0=disp ... if BIT CGFLG[R10],CGUNDEFB not zero then begin ... if TESTL RR6 not zero then NDFERR() ... PUTCHAIN(R3:=R10; LDL RR4,DTAPTADSBCP save R6,R7 if ADMD='K' and RL1='2' then begin LDL RR6,OPVAL if R7<=16 then begin ...save regs. thru here if R7<>0 then begin RL3:=XLATREG(RL3)*010; RL3:+RL7-1 RH3:=0A9 ...INC if OPCDW=083 then RH3:=0AB ...DEC LNGTH]; RH6:=0 if R6>SHORTNM then begin RL0:=RL6; SETB RL0,7; RL0:->@R7' end PUTFILE(R3:=^SYMTBBF; R7:) PUTFILE(R3:=R8+NAME; R7:=R3+R6) R0:=SHORTNM-R6 if R6>SHORTNM then begin R6:+(SN_NAME+1) R0:=SN_ENTSZ-(R6%SN_ENTSZ) end if#1 not zero then begin if TESTL RR8 zero then PUTLDCON(RL3,RH7) ...also passes RR0 else if CPL RR8,#2 then begin ADMD:=0 PUTADD(RL3,RL3,RH7) end else if ISPWR2(LDL RR2,RR8)->R1 then begin PUTSHFT(RL6,R7,R1) end else if RH7<='2' nd, restore RELOTBX PUSH RELOTBX NXTSYMO0() while R8:=NXTXSYM() do begin if B.@R8[SCLASS]=EXTERN then begin R3:=@R8[SNUM]; R5:=SYMTBSZ/SN_ENTSZ; CALL ADDXRELO end RL0:=@R8[LNGTH]+1; RH0:=0; ...R3:+STRTBSZ->STRTBSZ if R0<=SHORTNM then R0TR) ... end else begin ... if BIT CGFLG[R10],UNFIXB zero then begin ...if value fixed ... LDL RR2,R10[ADRHI]; ADDL RR2,RR6 ... WRADR_D(LDL RR4,DTAPTR) ... ...also put in relocation table ... end else begin ... if TESTL RR6 not)  WRCDW(R3) end JR PUTADSBX end end PUTADSBCP(RL3,RL5,RL1) PUTADSBX~ restore R6,R7 RET PUTADSBCP: ...write out code for add,sub,cp; RL3,RL5=dest,source regs(0FF=>kon) ...RL1=size char, also have OPCDW,OPCDL,ADMD,OPVAL save R6 RL6:=RL.. if R6=(MAXREGNO-1) then R6:=1 RL0:=PSHFLG if BITB RL0,R6 not zero then PUTPOP(RL6) until R6=0; restore R6 RET PUTCVFLT: ...enter RL3=reg; put out code to convert (long) int. to float RL5:=CnvFlt; JR PUTFCVT ... PUTCVINT: ...enter RL3=reg; XTTYP(R13) then begin GETSYMADR(R13); OutADR() end ... else begin ... OutSP(); OutSP(); R3:=GETVAL(); HLout(R3) ...put out symbol value ... end ... OutSP() ... HLout(@R13[TYPE]); OutSP() ...put out TYPE ... Outhex(RL0:=@R13[SFLAGS+1]) ...low byte of Sthen begin WRCDL(LDL RR2,#0B107,09A40) ...EXTSL RQ0; DIVL RQ0,RR4 end else if R7='4'*0100+'u' then begin WRCDL(LDL RR2,#09042,0EF02) if MODFLG=0 then R3:=09222 else R3:=09420 WRCDW(R3) WRCDL(LDL RR2,#0E807,0A74F); WRCDW(0E603) o then R3->R1 ...new least name end RL0:=1 ...for NXTsym end R1:->LastNm; R13:=R1-NAME R1==^NmFF; COMFLG Z; RET CPName~ PROC ...compare name pointed to by DE to name pointed to by HL ...enter HL,DE at NAME in symbol tbl (LNGTH before); preserv1 RL3:=OPREGCD(RL3,RL5) RH3:=OPCDW if RL6>'2' then RH3:=OPCDL if ADMD='K' then begin RES R3,15; WRCDW(R3) LDL RR2,OPVAL if RL6>'2' then WRCDL() else WRCDW(R3) end else WRCDW(R3) restore R6 RET PUTOR: OPCDW:=085 PUTANDORX() RET PUTAND: put out code to convert float to (long) int. RL5:=CnvInt PUTFCVT~ ...enter RL3=reg for unary float op, RL5=SC # save R6 RL6:=RL3; RH6:=RL5 PUSHREGS(RL3,RL3,MAXREGNO) if RL6<>0 then PUTLDREG(B.0,RL6) RH3:=07F; RL3:=RH6; WRCDW(R3) MLTD2(RL6,B.0) restFLAGS ... Outhex(RL0:=@R13[SCLASS]) ...SCLASS ... OutSP() ... R3:=R13+NAME ... LDIRB @R7,@R3,R6 ...put out name ... R3:=^BUFF-1 ... repeat R3:+26 until R3>=R7; ... repeat OutSP() until R7>R3; ... if R7>^BUFF+77 then begin R7:-1; Outmsg(); Outset() end .. if MODFLG=0 then LDL RR2,#0BD20,0BD31 else LDL RR2,#09420,09240 WRCDL() WRCDL(LDL RR2,#0E802,09200); WRCDW(09A40) ...if RR2@R3 then RH1:=@R3 ...min. len.->RH1 RH0:=flag repeat R3:+1; R7:+1 ...cmp. chars. in name if RL0:=@R7<>@R3 then begin POP R3; POP R7; JR CPNX e OPCDW:=087 PUTANDORX() RET PUTXOR: OPCDW:=089 PUTANDORX() RET PUTANDORX: ...write out code for and,or,xor ...enter RL3,RL5=dest,src regs (0FF=>kon), RL1=size char, ...also have OPCDW,ADMODE,OPDVAL save R7..R9 RL7:=RL1; LDL RR8,OPVAL RL3:=OPREGore R6 RET PUTFLTOP~ ...enter RL3=dest reg, RL5=src reg, RL1=SC# for float op save R6 RL6:=RL3; RH6:=RL1 MLTD0(RL3,RL5) RH3:=07F; RL3:=RH6; WRCDW(R3) if RH6=FCmp then WRCDL(LDL RR2,#0B03,0) ...if compare, add: CP R3,#0 MLTD2(RL6,B.0) restore R6 . R7:->Nxtpos ... restore R7..R9 ... RET TUDEEP: Errm(); DEFT 'OVER NESTED' ...nested too deep Sav: PROC ...puts bytes from ^BUFF to R7, then count, in STACK starting ...at W.FREE; W.FREE updated; DE pointed again to source SAVX(R3:=^BUFF) JP OUTDUNRR0:=0; DIVL RQ0,RR4 end end RL5:=0 ...RR2 if MODFLG<>0 then RL5:=2 ...RR0 ...reg. containing result=RR2/RR0 MLTD2(RL6,RL5) end restore R6,R7 RET MLTD0: ...enter with RL3=dest. reg., RL5=source reg. or =0FF if source=const ...allocate regnd until RH1:-1 zero; POP R3; POP R7 RH0:->flag ...flag from len. comparison CPNX~ POP R1; RET SCSYMS: DEFM 'MACAu?UndstaRg?EXTLa?UL?MOS???SNmMOUUNmTypMOE???' TMODSYMS: BYTE ARRAY; DEFM ' ^fa' BTSYMS: DEFM ' ChShI LgFlDbStUn BFUSUIUL' PutOut: .CD(RL3,RL5)->RH7 RH3:=OPCDW if ADMD='K' then begin RES R3,15 WRCDW(R3) R3:=R9; if RL7>'2' then R3:=R8 end WRCDW(R3) if RL7>'2' then begin RL3:=RH7+011 RH3:=OPCDW if ADMD='K' then begin RES R3,15; RL3:&0F WRCDW(R3) R3:=RET ...the following are in CODEGEN: CONVERT_: CALL CONVERT; RET CNVTACC_: CALL CNVTACC; RET CKFREE_: CALL CKFREE; RET REQREG1_: CALL REQREG1; RET RELREG_: CALL RELREG; RET  ...OBJSZ: LONG 0 ...passes object size to PTRADDSUB,SUBPTRS ...ADDSBCD: BY ...NEXTDE->R7; 1->Z; RET ... ...SavB: Outset(); Outhex(); JR Sav ...save RL0 in hex SAVX~ ...saves from R3 to R7 on STACK R1:=R7-R3; RL0:=RL1 ...length->R1->RL0 R7:=FREE ...get dest. if not zero then LDIRB @R7,@R3,R1 ...copy bytes RL0:->@R7' ..s RR0,RR2,RR4 for long mult/div & load up ...if need to save regs., do push, remember in PSHFLG ...(RR0=reg #MAXREGNO, RR2=reg#0, RR4=reg#1) save R6,R7 RL6:=RL3; RL7:=RL5 RL1:=2; if RL7=0FF then RL1:=1 ...if mult*k, don't need reg#1 (RR4) PUSHREGS(R..put out Map entries, starting cols. 0,26,52 ...enter with R13 pointing to symbol tbl entry, Nxtpos=curr. col. save R6..R10 R7:=Nxtpos RL6:=@R13[LNGTH]; RH6:=0 R0:=@R13[TYPE]; R1:=3; R8:=TMASK; R9:=-4; R10:=^BUFF+100 repeat R3:=R0&R8; JR Z,PO2 R9 end WRCDW(R3) end restore R7..R9 RET PUTSHFTD: ...shift left (dynamic) if ADMD='K' then begin PUTSHFT(RL3; RH5:=RL1; RL5:='u'; LDL RR0,OPVAL) RET end save R6,R7 RL7:=RL5; RH7:=RL1 RL6:=XLATREG(RL3)*010 RH3:=XLATREG(RL7); RL3:=0 R2 RL3:=ACCSTK[ACCLVL-1]; RL6:=CNVTACC(RL3,B.(SZINT+'0'))->RL7 if CDBITSZ<>(SZINT*8) then begin B.REQREG(B.(SZINT+'0'))->RL3->RL7; PUTLDREG(RL3,RL6) ...above not necessary if 'R' follows R5:=PWR2M1(CDBITSZ) PUTMSK(RL7,R5) RL1:=CDBITO; RH1:=0 .save count R7:->FREE RET Re: PROC ...restore last item on stack to @R7+.. Ig() RE1~ R1==0; RET Z LDIRB @R7,@R3,R1; RET Pp: PROC ...effectively pops to @DE+.. & pushes again (leaves on stack) RPI(); JR RE1 Ig: PROC ...pop last item from stack withoL3,RL5,RL1) ... PSHFLG:=0; RH6:=0 ... repeat ... if RH6=RH7 then RH6:=MAXREGNO ...only chk regs. using ... if RH6<>RL6 and RH6<>RL7 and CKFREE_(RH6) not then begin ... PUTPUSH(RH6) ... RL3:=RH6; RH3:=0; RL0:=PSHFLG; SETB RL0,R3; RL0:->PSHFLG . ...SDL R3,R9 R5:=R9; repeat R3:/2 until R5:+1 zero; RL3:->@R10' R9:-2; R8:*4 until R1:+1=3+6; PO2~ if R1=3 then R1:+1 ...R1=len of type+space when printed out if R7+R1+R6>^BUFF+(77-11) then begin Outmsg(); Outset() end if CKEXTTYP(R13) then b:=0B303 if RH7='4' then RL2:+4 RL2:|RL6 WRCDL() restore R6,R7 RET PUTSHFTDR: ...shift right (dynamic) if ADMD='K' then begin PUTSHFT(RL3; RH5:=RL1; RL5:='u'; LDL RR0,OPVAL; R1:=-R1) RET end save R6,R7 RL6:=RL3; RH7:=RL1 RL7:=CNVTACC_(RL5,B)  PUTSHFT(RL7,'2'*0100+'u',R5) B.REQREG(B.(SZINT+'0'))->RL3->RH7 PUTILDV(RL3; RL5:=SZINT; SUBL RR0,RR0) ...also gets passed IREG R5:=PWR2M1(B.(SZINT*8))-PWR2M1(CDBITO+CDBITSZ)+PWR2M1(CDBITO) PUTMSK(RH7,R5) ...mask off bit field PUTOR(RL7,ut putting anywhere ... ret. R1=len.; Z=0 RPI() R3->FREE ...adjust stack pointer RESFLG Z; RET RPI: ...ret. R3=^prev. string, R1=length R3:=FREE RPI2~ R3:-1 RL1:=@R3 RH1:=0 R3:-R1 ...R3->first char. RET Xc: PROC ...swap top two, DE unchanged .. end ... until RH6:+1>MAXREGNO; if RL7=0 then begin ...if RR2=source if RL6<>1 then begin PUTLDREG(B.1,RL7); RL7:=1 end ...if RR4<>dest then RR2->RR4, source=RR4 else begin PUTLDREG(B.MAXREGNO,RL7); RL7:=MAXREGNO end ...else RR2->RR0, sourcegin GETSYMADR(R13); OutADR() end else begin OutSP(); OutSP(); R3:=GETVAL(); HLout(R3) ...put out symbol value end OutSP() ...put out sclass: RL0:=@R13[SCLASS] if RL1:=RL0&BSCMASK>=16 then RL1:=15 RL3:=RL1; RL1:*2+RL3; RH1:=0 ...RL1:*3 R1:+^SC.'2') PUTNEG(RL7,B.'2') PUTSHFTD(RL6,RL7,RH7) restore R6,R7 RET ...PUTMULT-PUTMOD enter with RL3=dest. reg., RL5=source reg., ... R1=size/type/signedness chars (e.g. '2s') PUTMULT: if RH1='d' then begin PUTFLTOP(RL1:=FMult); RET end if ADMD='K' theRH7,B.(SZINT+'0')) REMOVE(); REMOVE() end PUTSTI(RL3:=RL7; RL5:=SZINT; SUBL RR0,RR0) ...also gets passed IREG REMOVE() restore R6,R7 RET FORCE: ...make sure result in current accum. is in ret. register; @R3=size save R6..R7 RL0:=@R3; RL6:=ACCSTPUSH R7; PUSH R7 Re() ...1st string out PUSH R7 ...^ end 1st Re() ...2nd string out POP R1 ...end 1st POP R3 ...beg. 1st PUSH R7 ...end 2nd PUSH R1 ...end 1st; beg. 2nd R7:=R1 SAVX() ...save 1st POP R3 ...beg. 2nd (this pop & prev. push e=RR0 end if RL6<>0 then PUTLDREG(B.0,RL6) ...if RR2<>dest, RR2:=dest if RL7<>1 and RL7<>0FF then PUTLDREG(B.1,RL7) ...if RR4<>source (& source<>const), RR4:=source restore R6,R7 RET PUSHREGS: ...push out push of regs in range 0..MAXREGNO <>reg# SYMS RH4:=@R1; RL4:=@R1[1]; RH5:=@R1[2] if BITB RL0,STATICB not zero then begin SETB RH4,5; SETB RL4,5; SETB RH5,5 ...make small letters end RH4:->@R7'; RL4:->@R7'; RH5:->@R7' OutSP() ...put out type: if R9:=^BUFF+100=R10 then OutSP() else begin begin PUTMLTK(RL3; R5:=R1; LDL RR0,OPVAL); RET end save R6,R7 RL6:=RL3; RH6:=RL5; R7:=R1 if RH7<='2' then begin RL3:=CNVTACC_(RL3,'4') RL3:=OPREGCD(RL3,RH6); RH3:=099 WRCDW(R3) end else begin MLTD0(RL6,RH6) WRCDW(09840) ...MULTL RQ0,Rnce: R13:=TABBSE+(NHASH*2+2) while TSTEND() RR2, tag->RL5, poss. symptr->R1, poss. size ... of object poiRL3 or reg# RL5 ... when get to reg# RL1, skip to MAXREGNO ...save regs. pushed in PSHFLG save R6,R7 RL6:=RL3; RL7:=RL5; RH7:=RL1 PSHFLG:=0; RH6:=0 repeat if RH6=RH7 then RH6:=MAXREGNO ...only chk regs. using if RH6<>RL6 and RH6<>RL7 and CKFREn RH1:=0 repeat RL1:=@R9 TMODSYMS[R1]->@R7' until R9:+1=R10; end R1:=@R13[TYPE]&BTMASK R1:*2+^BTSYMS R0:=2; LDIRB @R7,@R1,R0 ... HLout(@R13[TYPE]); OutSP() ...put out TYPE ... Outhex(RL0:=@R13[SFLAGS+1]) ...low byte of SFLAGS ... OR4 MLTD2(RL6,B.0) ...0=RR2 end restore R6,R7 RET PUTMOD: MODFLG:=1; PUTMD2(); RET PUTDIV: if RH1='d' then begin PUTFLTOP(RL1:=FDiv); RET end MODFLG:=0 ... PUTMD2() ... RET ...fall thru: ... PUTMD2: if ADMD='K' then begin PUTMDK2(RL3; R5:=R1; LDlse begin ...do alphabetically: LastNm:=^Nm00 while GetLNm() zero do PutOut() end if R7:=Nxtpos<>^BUFF then Outmsg() ...if not 1st col, put out last line if MAPTYP<>0 then begin Icopy(); DEFT 'Rem Space='; BYTE 0 TSTEND() ...get R1=^end ofnted to->PTRSZ; dec R7 RL3:=@(R7:-1); RH3:=@(R7:-1); RL2:=@(R7:-1); RH2:=@(R7:-1) RL5:=@(R7:-1) if RL5='a' then begin RL1:=@(R7:-1); RH1:=@(R7:-1) RL0:=@(R7:-1); RH0:=@(R7:-1); R0:->PTRSZ end RET INSVAL~ RL5:->@R7' ...fall thru: INS_L: RH2:->@E_(RH6) not then begin PUTPUSH(RH6) RL3:=RH6; RH3:=0; RL0:=PSHFLG; SETB RL0,R3; RL0:->PSHFLG end until RH6:+1>MAXREGNO; restore R6,R7 RET MLTD2: ...enter with RL3=reg# for result, RL5=current reg. no. ...]as in inst. ...load reg. if necesuthex(RL0:=@R13[SCLASS]) ...SCLASS OutSP() R3:=R13+NAME LDIRB @R7,@R3,R6 ...put out name R3:=^BUFF-1 repeat R3:+26 until R3>=R7; repeat OutSP() until R7>R3; if R7>^BUFF+77 then begin R7:-1; Outmsg(); Outset() end R7:->Nxtpos restore R6..R10 RETL RR0,OPVAL); RET end PUTMD3: save R6,R7 RL6:=RL3; RH6:=RL5; R7:=R1 if R7='2'*0100+'s' then begin PUTEXT(RL6,'4'*0100+'s',R7) RL3:=CNVTACC_(RL6,'4') RL3:=OPREGCD(RL3,RH6); RH3:=09B WRCDW(R3) if MODFLG<>0 then begin RL3:=XLATREG(RL6)-> symbols R3:=ENDTAB-R1 ...calc. remaining space HLout(R3); Outmsg() ...print Rem Space=hhhh end POP R7; R0==R0; RET GetLNm~ ...get least name>LastNm pointed to by R13 (@LOC) & LastNm (@NAME) ...ret. Z=1 iff find any R1:=^NmFF; RL0:=0 ...curreR7'; RL2:->@R7' INS_W: RH3:->@R7'; RL3:->@R7'; RET PpV: ...tag on STACK->RL5, value->RR2, poss. symptr->C_SYMP; leave on STACK Outset(); Pp(); POPN(); OUTDUN(); RET ReK: ReV: ...remove from STACK: tag->RL5, value->RR2, poss. symptr (or snum)->R1, ... asary, then, if regs. were pushed in MLTD0, pop ... them (use PSHFLG) ... RH5:=0 ... if RL3<>(RL1:=REGXLTB2[R5]) then PUTLDREG(RL3,RL1) if RL3<>RL5 then PUTLDREG(RL3,RL5) ...put out pop of regs marked in PSHFLG save R6 R6:=MAXREGNO+1 repeat R6:-1 . ...PutOut: ...put out Map entries, starting cols. 0,26,52 ... ...enter with R13 pointing to symbol tbl entry, Nxtpos=curr. col. ... save R7..R9 ... R7:=Nxtpos ... RL6:=@R13[LNGTH]; RH6:=0 ... if R7+R6>^BUFF+65 then begin Outmsg(); Outset() end ... if CKERL0; RL3:=(RL3-1)*010+RL0 RH3:=0A1; WRCDW(R3) end end else begin if R7='2'*0100+'u' then begin RL6:=CONVERT_(RL6,'4'*0100+'s',R7) RH6:=CONVERT_(RH6,'4'*0100+'s',R7) R7:='4'*0100+'s' end MLTD0(RL6,RH6) if R7='4'*0100+'s' nt least name stored in R1 while NXTsym() zero do begin R3:=R13+NAME ...R3 pts. @NAME of next entry R7:=LastNm ...last symbol put out if CPName() LastNm R7:=R1 ...current least name if CPName() >=zer* lso poss. size of object pointed to Outset(); Re(); POPN(); OUTDUN(); RET SVVAL: ...save RL5=tag (not 'a'), RR2=value on STACK Outset(); INSVAL(); Sav(); RET SVADRVAL: ...save in binary on STACK: R5=size of object pointed to, R1=^symtab ... (or snum),,EMPTY then begin ...join below R6:+R2; R7:=R3; R5:=R4 end R4:=R5+R6; LDL RR2,@R4 if BIT R3,EMPTY then begin ...join above R6:+R2; R4:+R2; LDL RR2,@R4 end ... if R6>R3 then begin R3:=R3&0F+R6; LDL @R4,RR2 end R3:=R3&(2**EMPTY)+R6; LDL @R4RET NC ...do Step, chk if R_SPB.TSTCCC; RH0:=0 R1:=RFC_; RL1:->flag BYTE 0AE ...TCCB TSTCCC~ BYTE 0 RH0:-1; RET Step~ PROC ...execute next instruction  'a', RR2=value Outset(); INSADRVAL(); Sav(); RET INSADRVAL~ ...addr val params->@R7' PUSHL RR2; INS_W(R5); INS_W(R1); B.'a'->@R7'; POPL RR2; INS_L() RET Calc: PROC ...do operation and leave answer in buffer with R7 after ...enter with @(R7-1)=op, b,RR2 LDL @R5,RR6 POPL RR6; RET .../M_INIT() M_REQE: PROC M_REQ(); RET Z Errm(); DEFT 'MEMORY POOL USED UP' ...************* CKEXTTYP: PROC ...chk if symbol with symptr @R3=extdef/static if RL0:=@R3[SCLASS]<>EXTDEF then RL0==STATIC RET GETSYMADRepSP(); POP R1 ...do Step & comp. R_SP to orig. ... RET NC ...if R_SP>=orig. R_SP ... until RH1:-1 zero; ... W.SAVADR; B.RDaHL()->SBInst ...store inst from @(ret. addr.) ... if PutBrkW() zero then begin ...put out 0E00; Z=0 =>rom ... R3->SBAddr; R1PCALC~ ...do RR2=RR2 op RR4 where RL1=compare op case RL1: of '=': begin SUBL RR0,RR0; CPL RR2,RR4; TCC EQ,R1; LDL RR2,RR0 end '#': begin SUBL RR0,RR0; CPL RR2,RR4; TCC NE,R1; LDL RR2,RR0 end '<': begin SUBL RR0,RR0; CPL RR2,RR4; using stored regs.; store new regs. LDL RR2,RPC_; LDL R_PC0,RR2 ...save PC if CKBRKPT(LDL RR6,RR2) zero then begin ResINST(R0:=@R3; LDL RR2,RR6) ...if at brkpt., restore inst. if not zero then BRKOFF() ...if no 0E00 (possible if overlays) end efore op=last operand, ... before that=2nd to last operand, etc ...float assumes 0=0 value save R6,R8..R13 B.@(R7:-1)->C_OP POPN() ...get last operand->RR2, tag->RL5, poss. symptr->R1 if begin PUSH R1; CKUNOP(RL0:=C_OP); POP R1; R0:=PTRSZ end not th: R3:=@R3[SNUM]; CALL GETCGADR; RET ...only call for external syms. ...************* TEST: ADDR Test DEL: ADDR Del ICOPY: ADDR Icopy COPYIN: ADDR Copyin COPY: ADDR Copy OUTSET: ADDR Outset OUT: ADDR Out ...OUTN: ADDR OutN SAV: ADDR Sav ...SAVB: ADDR Sav5:->SSP ...set special brk; save SP ... JP Go ...go ... end ...SStep3: repeat StepSP() until >=zero; ...do Steps until R_SP>=orig. R_SP ... RET ...SBRET~ ...come here after sp. brkpt (used by SStep) hit ... R15:=SSP ... ...ResSBrk~ ...reset special TCC LT,R1; LDL RR2,RR0 end '>': begin SUBL RR0,RR0; CPL RR2,RR4; TCC GT,R1; LDL RR2,RR0 end '[': begin SUBL RR0,RR0; CPL RR2,RR4; TCC LE,R1; LDL RR2,RR0 end ']': begin SUBL RR0,RR0; CPL RR2,RR4; TCC GE,R1; LDL RR2,RR0 end end FNDNXTPC() ...get PC after current inst.->RR2 RDR1aRR2(); R1:->STBINST ...store following inst. PutBrkW(); JR NZ,STRET2 ...put out 0E00; Z=0 =>rom LDL STBADDR,RR2; R15:->STSP ...set brkpt on next inst; save SP JP Go2 ...execute the inst. STRET~ .en begin RH6:=RL5; R13:=R1; LDL RR10,RR2; R0:->PTRSZ2 POPN() RL6:=RL5; R12:=R1; LDL RR8,RR2; PTRSZ1:=PTRSZ if RL0:=C_OP='?' then begin POPN() if TESTL RR2 zero then begin LDL RR2,RR10; RL5:=RH6; R1:=R13; R0:=PTRSZ2 end el@R3,R1,EQ if zero then begin R9:+4; RET end RH0:=RH5; RESB RH0,0 if RH0=0B2 then begin R9:+2 ...rotates=1 word if BIT R5,0 not zero then R9:+2 ...shifts=2 words end RET IRET_~ R3:=R15_+4; JR RET2 ... RET_~ R9:+2; TSTCC(RL0:=RL5); RET NZ R3:=break used by SStep ... LDL RR2,SBAddr; R3==0FFFF; RET Z ... ResINST(R1:=SBInst); LD SBAddr+2,#0FFFF; RET /SEG B_RTN: ...control goes here after break (PC,FCW on stk) ...(written so can run on any seg.) PUSHL RR2 LD R3,RR14[6]; LDR RFC_,R3 ...get & s RET FBINCALC~ ...do RR2=RR2 op RR4 where RL1=op and op=float op ...also ret. RL5='f' or 'K' (type of result) case RL1: of '+': begin FLTADD(); RL5:='f' end '-': begin FLTSUB(); RL5:='f' end '*': begin FLTMULT(); RL5:='f' end '/': begin FLTD..ret. here after Step R15:=STSP RESSTBRK() ...res. inst @brkpt STRET2~ LDL RR6,R_PC0 if CKBRKPT() then WRR1aRR2(LDL RR2,RR6; R1:=0E00) ...if were at breakpt., restore '0E00' RET ...ResSBrks~ ResSBrk() ...reset sp. SStep brk ... RESSTBRK~ ...resse begin LDL RR2,RR8; RL5:=RL6; R1:=R12; R0:=PTRSZ1 end end else if RL6='f' or RH6='f' then begin if RL6='a' or RH6='a' then WRGTYP() if RL6='K' then begin CNVFLT(LDL RR2,RR8); LDL RR8,RR2 end if RH6='K' then begin CNVFLT(LDL R15_ RET2~ R2:=R8 if BIT RFC_,15 not zero then begin ...if seg'd R2:=R14_ RDR1aRR2(); R1:->R8 R3:+2 end RDR1aRR2(); R1:->R9 RET JR_~ R9:+2; TSTCC(RL0:=RH5); RET NZ RL0:=RL5; EXTSB R0 R9:+(R0:*2); RET DJNZ_~ R9:+2; RL1:=RH5&0F; RH1:=0 if tore FCW LDL RR2,RR14[8]; LDRL RPC_,RR2 ...get & store PC LDCTL R3,NSPSEG; LDR N14_,R3 ...nonseg R14 POPL RR2 R15:+8; LDRL R14_,RR14 ...save adjusted RR14 LDRL R12_,RR12; LDR R12,QSEG; R13:=^RRS_ LDM @RR12,R0,12 ...store rest of regs. in variableIV(); RL5:='f' end '=' or '#' or '<' or '>' or '[' or ']': begin PUSH R1; FLTCMP(); POP R1; SUBL RR4,RR4; CPCALC() RL5:='K' end else WRGTYP() end RET ...manager of memory: ...1) buffers are allocated in a first fit manner ...2) buffer et Step break LDL RR2,STBADDR; R3==0FFFF; RET Z ResINST(R0:=STBINST); LD STBADDR+2,#0FFFF; RET CkInst0~ ...ret. inst. @RPC_ in R5; also set RR2=RPC_ CK0E00(LDL RR2,RPC_); R1:->R5; RET NZ ...chk if brk word (0E00) CKBRKPT(LDL RR6,RR2); R3<->R7; RET NZRR2,RR10); LDL RR10,RR2 end FBINCALC(LDL RR2,RR8; LDL RR4,RR10; RL1:=C_OP) end else begin ...fix up sizes if have ptr op R2:=0 if RH6='a' and RL6<>RH6 then begin R3:=PTRSZ2; MULTL RQ0,RR8; LDL RR8,RR2 end if RL6='a' * BIT R5,7 zero then begin ...if byte if BIT R1,3 not zero then begin RES R1,3; R1:*2+1 end else R1:*2 RL3:=RRS_[R1]; RH3:=0 end else R3:=RRS_[R1:*2] R3-1; RET Z ...will dec to 0 R1:=R5&07F==1; RET Z ...sp. case for DJNZ $ R9:=R9-(R1:*2); RETs LDR R2,QSEG; R3:=R14; SET R3,15; RL3:=0 if R3<>R2 or R15<=(^MYSTAK+030) or R15>^MYSP then begin R3:=^MYSP; LDL RR14,RR2 ...set SP (leave if in Q's stk) end R3:=flag; RES R3,15; R3->flag ...04000->flag /NONSEG LDL RR6,RPC_ CPL RR6,STBADDR; JP Zsizes are multiples of 16 bytes ...3) the first two words contain relative double links to neighbor buffers BUFMLT~ EQU 2 ...buffer size made mult. of this (must be even) EMPTY~ EQU 0 ...low bit of back ptr (0=>buffer empty) ...Note: BUFSZ-4 must be mul R5:=@R7; RET ...if set brk, get orig. inst. Call~ PROC ...tests for a call instruction @RPC_; Z=1 iff true ...ret. RR2=RPC_, R5=inst CkInst0() ...inst->R5 RL0:=RH5&0F0==0D0; RET Z RL0:=RH5&03F==01F; RET Z RH5==07F; RET ...Pop: PROC ...check forand RH6<>RL6 then begin R3:=PTRSZ1; MULTL RQ0,RR10; LDL RR10,RR2 end LDL RR4,RR10; LDL RR2,RR8 BINCALC(RL1:=C_OP) ...RR2=RR2 op RR4 if RL6='a' and RH6=RL6 then begin R4:=0; R5:=PTRSZ1; DIVIDE() ...divide RR2:/RR4 en ...note: for now, CALL_ & CALR_ must save R7 CALL_~ PUSHL RR8; CNTREG(); POPL RR2; JR CALJP2 ... JP_~ PUSHL RR8; CNTREG(); POPL RR2 TSTCC(RL0:=RL5); RET NZ CALJP2~ if RL0:=RH5&0C0 zero then begin ...IR mode RL1:=RL5/16*2; RH1:=0 R9:=RRS_[R1] B,STRET ...chk if was Step brk ... CPL RR6,SBAddr; JP Z,SBRET ...chk if was spec. brk (used by SStep) R3:=BRKEXT if BIT R3,0 zero then begin CALL @R3; JR CONTX end ...chk if to execute procedure & then cont. CKBRKPT(); RH0:=flag; PUSH R0 if zero t. of BUFMLT M_INIT: PROC ...initializes the buffer area R5:=^BUFFER R0:=BUFSZ-4; R1:=0 LDL @R5,RR0 R1:=R0; R0:=0; R5:+R1; SET R1,EMPTY; LDL @R5,RR0 R0==R0; RET M_REQ: PROC ...expects R3 with size; returns R3 with pointer to buffer or NZ PUSHL RR POP -- or EX (SP),-- inst. @R_PC ... CkInst0() ...get inst.->R.A, R_PC->HL ... RL0==0C1; RET C ... if RL0=0FD or RL0=0DD then RDaHL(R3+1) ... RL0==0E3; RET Z; RL0&0F-1; RET StepSP~ ...do Step, then compare RR14_ to RR6=orig. RR14_, preserving RR6 ... rd R1:=R13; R0:=PTRSZ2 if RL6='a' then begin R1:=R12; R0:=PTRSZ1 end RL5:='K' if RL6<>RH6 then RL5:='a' end end if RL5='a' then INSADRVAL(R5:=R0) else INSVAL() ...save answer restore R6,R8..R13 RET CKUNOP~ ...if RL0=unary op, dIT RFC_,15; RET Z RES R1,1; LDL RR8,RRS_[R1] RET end ...get addr: RDR1aRR2(R3+2); R1:->R9 if BIT RFC_,15 not zero then begin ...if seg'd if BIT R1,15 zero then begin ...short offset RH1:->RH0; SETB RH0,7; RL0:=0; RH1:=0 LDL RR8,RR0then begin ...Z=1 indicates was set brkpt. if RL0:=@(R3:+3)<>0 then DECB @R3 ...dec. repeat count if RL0:=@R3<>0 then begin CONTX~ R15:=^TMPSP; JP Go ...do Go if repeat count>0 end R1:=@(R3:-3); WRR1aRR2(LDL RR2,RR6) ...restore inst. fo6 ... R3:+19&0FFF0 ...add space for links and make multiple of 16 R3:+(4+BUFMLT-1)&(-BUFMLT) ...FIRST_BUFFER()->RR6 R5:=^BUFFER LDL RR6,@R5 ...while NOT_EMPTY() or TOO_SMALL() do if NEXT() not then BREAK while BIT R7,EMPTY not or R6=RR6 PUSHL RR6; Step(); POPL RR6 LDL RR2,R14_ if BIT RFC_,15 not zero then begin R2==R6; RET NZ ...if seg'd, must be same seg. end if R3>R7 then begin R7==0; COMFLG Z end RET SStep~ PROC ...steps over subroutines ...specificalo it, ret Z=1 ...enter RR2=number, RL5=type tag ...ret. new RR2; RL5=type tag; if fail, preserve regs.>R1 if RL0='!' then begin if TESTL RR2 zero then R3:=1 else SUBL RR2,RR2 RL5:='K' end else if RL0='n' then begin if RL5='f' then begin FLTNEG end else begin R1:->R8 RDR1aRR2(R3:+2); R1:->R9 end end RL1:=RL5/16; RET Z ...DA (/16=SRL) RL1:*2; RH1:=0 R9:+RRS_[R1]; RET ...X CALR_~ R1:=R5&0FFF if BIT R1,11 not zero then R1:|0F000 R9:=R9+2-(R1:*2); RET LDPS_~ CALL_() ...RRr Dump end LDL RR2,RR6; PUSHL RR2 Dump1() ...display memory if Call() then begin ...rets. RR2=RPC_ Outset(); RL0:=9->@R7'; RL0:->@R7'; DEASMC(); Outlin() ...disassemble end PRTRR(RL0:=2) ...print regs. POPL RR2 POP R0; RH0:->flag; if zero then R5:+R6; LDL RR6,@R5 if R6==0 then begin RESFLG Z; JR BREAK0 end end ...BUFFER_SPLIT() EX R3,R6; SET R7,EMPTY; LDL @R5,RR6 if R3:-R6 not then begin R7:=R6; R6:=R3; R3:=R5; R5:+R7; LDL @R5,RR6 R5:+R6+2; R7:=@R5&(2**EMPTY)+R6->@R5ly if Call skips until RR14_>=old Stack Pointer if Call() not zero then begin ...chk if at CALL Step(); RET end LDL RR6,R14_ repeat StepSP() until zero; ...do Steps until RR14_>=orig. RR14_ RET ...note: if subr. pops stack & changes ret. addr.,(); RL5:='f' end else begin COM R3; COM R2; ADDL RR2,#1 end end else begin RL0=='~'; RET NZ COM R3; COM R2 end R0==R0; RET BINCALC: ...do RR2=RR2 op RR4 where RL1=op case RL1: of '+': ADDL RR2,RR4 '-': SUBL RR2,RR4 '*': MULTL RQ0,RR48=addr of status LDL RR2,RR8; R3:+2 if BIT RFC_,15 not zero then begin ...if seg'd RDR1aRR2(R3:+2); R1:->R8 R3:+2 end RDR1aRR2(); R1:->R9 RET SC_~ R1:=flag; SET R1,15; R1:->flag /SEG WORD 07D24 07D35 ...LDCTL RR2,PSAP LDL RR8,RR2[01C] RES n PutBrkW() ...restore '0E00' ... RESNCD() ...res. NCODE if offset R0:=RFC_; RL0:->flag; LDM R0,RRS_,14 ...restore regs. JP Debug Next~ ...if RL0=1, do NXTCNT insts.; if =2, same but skip proc. calls repeat PUSH R0 if RL0:-1 zero then Step() else; R5:=R3 end ...TRUE() R3:=R5+4; R3==R3 BREAK0~ POPL RR6; RET M_REL: PROC ...expects R3 pointing to buffer to be released ...BUFFER_JOIN() PUSHL RR6 R5:=R3-4; LDL RR6,@R5 RES R7,EMPTY ...R7:&0FFF0 R4:=R5-R7; LDL RR2,@R4 if R7<>0 and BIT R3 must do POP or ... EX (SP), within 4 insts. or goofs up ... if Call() not zero then begin ...chk if at CALL ... Step(); RET ... end ... ...note: DE=R_SP, HL=R_PC set in Call ... R3+3->SAVADR ...save ret. addr. for special break if used ... StepSP();  '/': DIVIDE() '%': begin EXTSL RQ0; DIVL RQ0,RR4; LDL RR2,RR0 end '&': begin R3:&R5; R2:&R4 end '^': begin R3:.XOR.R5; R2:.XOR.R4 end '|': begin R3:|R5; R2:|R4 end '{': SDLL RR2,R5 '}': begin R5:=-R5; SDLL RR2,R5 end else CPCALC() R1,15; R1:->flag /NONSEG RET CNTREG~ ...count # words in regular-type inst, update R9; save R5 R9:+2 RL0:=RH5&0C0; RET Z ...0=IR mode RL0==080; RET Z ...R mode ...left is DA/X LDL RR2,RR8 R9:+2; BIT RFC_,15; RET Z ...nonseg. RDR1aRR2(); BIT R1,+  SStep() Outset() OutADR(LDL RR2,RPC_); DNAM() ...print PC+disp from nearest symbol DEASM() ...disassemble Outlin() PRTRR(RL0:=0) ...display regs. that change POP R0 until DECB NXTCNT zero; ...dec. count JP Debug0 ...Trace~...traceegin LDCTL R3,NSPSEG; R3==08100 end THEN ORG 2.0100 /ELSE ORG 1.0100 /ENDIF *NONSEG ROM: ADDR 0100 RAM0: ADDR 0CE00 ...end of symtab & start of data; may be adjusted (see CDATA) RAM: ADDR RAM0 ORG ROM *DO CDATA *DO CBAS /DO MACDEFS /DO CFLOAT *DO CSUB 5:=^DATA1->LASTCR; B.0D->@R5 end MOVTXT() ...put out tab + move text to buffer, truncating if too long POP R1 ...ptr. to error in text PUSH R7 ...pts. after last char. in buffer if R3-R1>zero ...R3 at CR in text, R1 at error and begin PUSH R3; R; Err() ...BKDBG: NORMSG(R14_)->R2; R3:=R15_ ... if R2=QSEG and R3>(^TMPSP+030) and R3<=^MYSP then R15:=R3 ... else begin ...DBUG1: R15:=^MYSP ... end ... Debug0: R15:=^MYSP Debug: R0:->stk; R15:-28; LDM @R15,R1,14; flag->stk DBUG2: R15:->SAVSP; DBGFLG PUSH R1; RL1:=RL0; RH1:=0; LDB RH0,LUS-1[R1]; POP R1; RET STLU~ ...store LU# in RH0 in level RL0 RL0:->RL1; RH1:=0; LDB LUS-1[R1],RH0; RET CLOSFL~ ...close file of level RL0 (input=1-5, list=6, image=7) ...return RL0=cc FILLU(); R1:=0 SYSTM(RL0:=CLSs a routine, printing out names of all subroutines it executes ... indenting to depth of stack, up to a stack depth of NXTCNT words ... R_SP->R3 ... repeat PUSH R3 ...save orig. R_SP ... if Call() then begin ...Call sets DE=R_SP ... R3+3->SAVADR /DO XSUB /DO CGSUB /DO CGPUTS /DO CODEGEN *DO XXC *DO CBUG /DO PREPROS /DO CDECL /DO CX /DO CMAIN TABLE: WORD NHASH*2+2 0[NHASH] ENDTBL: ADDR RAM0 /MAP UNDEF ORG RAM *SEG ...*LDCTL R2,NSPSEG;LDCTL R3,NSPOFF;R4:=08100;if R4=R2 then R4:=08200;R5:=^TABLE;R13:=^DATA1-1-R1; POP R1 end R1 R3:=R7-1 ...R3 pts. at last char. in buffer LDDRB @R7,@R3,R1 ...shift text that is past error ahead 1 space in buffer end RL0::=1 ...if DBGFLG<>0, ret. here after Err RESSTBRK() ...reset sp. brk used by Step just in case missed Getcon(RL0:=DPRMPT) NGFLG:=0 if CPB @R7,#'/' then begin R7:+1 if CMD1() zero then begin CKEND(); JR DBUG2 end ...if cmd, don't offset NCODE ) RET Quit1: PROC ...close any open input files (INLVL>0) NOTASCFLG:=0 RL0:=INLVL==0; RET Z CLOSFL(RL0:) INLVL:-1 JR Quit1 EOFSEQ~ BYTE EOFCH 0D EOF LEOFSEQ~ EQU $-EOFSEQ BYTE 0 Quit: PROC ...close files Quit1() ...close any open input files ...needed by SStep2 ... if StepSP()R3 ...get diff. in stack level ... if NXTCNT*2>=RL3 then begin RL7:=RL3 ... if Name(R:=@RR2;LDIRB @RR4,@RR2,R1 *NONSEG ...* PACK() *TABINT() *SEG *WRITE"Type in:" /IF begin LDCTL R3,NSPSEG; R3==08100 end THEN *WRITE"/IMAGE C2 ",C," 0",TABLE+@TABLE-1," E=",C+2 /ELSE *WRITE"/IMAGE C ",C," 0",TABLE+@TABLE-1," E=",C+2 /ENDIF  C," 0",TABLE+@='?'->@R7 ...insert '?' before char. in error POP R7; R7:+1 ...pts. after last char. in buffer Outmsg() ...add CR & put out to $CON & file if open RESNSTe() ...res. STACK & NCODE (if error during IMMX, etc.) CALL SETOUTON ...make sure .OUT turned on FINCDGEN() OFFNCD(); JR DBUG3 ...if /instlist, offset NCODE (->R3) end ... PUSH NCODE ... OFFNCD() ...NCODE->SAVNCD; NCODE+040->NCODE ... if begin DBUG(); POP R3 end then begin ...DBUG cmds use offset NCODE if DBUG() then begin CKEND() ...chQuit2: PROC; RL0:=DIAGSW if BITB RL0,2 not zero then begin ...now close output file if open PUSH R7 PUTFILE(R3:=^EOFSEQ; R7:=R3+LEOFSEQ) ... R3:=FPUTNX; LDB @R3,#0FF ...put 'FF' for EOF at next pos in outpt buf ... FPUTRM:-1 PUTOUT() ...put_PC) and RH1|RL1 zero then begin ...if symbol at R_PC ... RH1:=RL7 ...diff. in stk level ... WSbgn(); COPYSP() ...put out R.B spaces ... R3->R13 ...HL pts. to entry in symbol table ... R1:=^NAME; R3+R1->R3 ... RL1:=@R13[LNGTH]; LDIRB @R7RD 0 R13_~ WORD 0 R14_~ WORD 08100 R15_~ WORD 0 N14_~ WORD 0 ...nonseg R14 RFC_~ WORD 04000 RPC_~ WORD 08100 WORD 0 RRS_0~ ;WORD 0[18] ...prev. value of regs. (thru RFC) stored here NXTCNT~ BYTE 0 ...count of how many NEXT's to do; also=max. depth (b ... NCODE->LSTNCD if NOTASCFLG<>0 then Quit1() ...if error while doing non-ascii file if INLVL<>0 then begin ...check if from $CON or file R7:=LASTCR; R1:=0200; RL0:=0D CPIRB RL0,@R7,R1,EQ ...scan to next CR end ST1: RH1:=1 ...flag for no QINk nothing else on line RESDBF() ...DBGFLG:=0 ... ResSVs() ...reset NCODE, NCDFLG, DBGFLG NGFLG==0; JR Z,DBUG2 ...if NGFLG<>0, means N,S,T,J or G cmd R0:=^NSTJG ...where to go end else begin ... R3:->NCODE ...=SAVNCD ... RETNCD() ...SA out last record CLFPT() ...close file POP R7 if RL0<>080 then begin DIAGSW:=0; WRTERR() end end ...ZDGSW~ DIAGSW:=0 ...reset DIAGSW R0==R0; RET STARS~ R7:=^BUFF ...start of buffer CALL Copy DEFT '***** ' ...into buffer BYTE 0; RET MOVTX,@R3,R1; WSend() ...print subr. name ... end ... end ... else SStep2() ... end ... end ... else Step() ... R7:=R_SP; POP R3 ...HL=orig. R_SP ... until R3 RESDBF ST1 := .DO(RL3:='D') {(.DO(RL0==0)) CHGMEM / Dump} := .DO(RL3:='R') PRTRRS := .DO(RL3:='R') (IT R15:=^MYSP ST2~ if DBGFLG<>0 then R15:=SAVSP ...chk if were in debugger if RH1=0 then QINIT() ...do init. set-up stuff (R8=myseg) GetrecD() ...get line of input or jp debugger ST3~ JP XMETA ...call parser /SEG START~ ...come here via call from enVNCD->NCODE Del(); CPB @R7,#0D; JR Z,DBUG2 ...DBUG3~ Del(); if CPB @R7,#0D then begin ResSVs(); JR DBUG2 end FINCDGEN() SAVENCD() DBUG3~ NCODE->XAdd; CALL STMT_0 ...INSTLIST if zero then FINCDGEN() if not zero then begin CKEND(); ResSVs(T: RL0:=9->@R7' ...put in tab R3:=LASTCR ...pos. after last CR in text R1:=LINEL-8-2 ...limit to search (-2 is for '?' or ' [') RL0:=0D; CPIRB RL0,@R3,R1,EQ R1:=R3-1 ...pos. of CR or end of line R1:-(R3:=LASTCR) ...length of line (without CR) REump; 5:Go end R15:=^TMPSP ...temp. stack in lower region of mystak RL0:=NGFLG==3; ...JR Z,Trace JP C,Next ...Next needs NGFLG in RL0 if RL0:-5 zero then begin ...Z=1 if "G", Z=0 if "J" Go~ ...continue execution: if at brkpt, do Step first (restore+  / "FC" .DO(RL0:=17) / "PC" .DO(RL0:=18) / "N4" .DO(RL0:=16)) .DO(RL1:=RL0*2;RH1:=0;LDA R3,RRS_[R1];R2:=QSEG) CHGMEM := .DO(RL3:='H') NS2 HISTORY := .DO(RL3:='G') .DO(NGFLG:=5) := .DO(RL3:='J') .DO(LDL RPC_,RR2;try Y POPL RR8 ...R8=my seg LDL RR4,RR14 R9:=^MYSP; LDL RR14,RR8 ...set SP (must do in seg'd mode) R3:=flag; RES R3,15; R3->flag ...04000->flag ...set nonseg'd /NONSEG LDL SYSSP,RR4 ...save system SP RH1:=0; JR ST2 /SEG START0~ ...come her via c); JR DBUG2 end ...no instlist CKEND() ...chk nothing else on line OJPBK(^RETDBG) ...put out code to jp to RETDBG ResSVs() ...reset NCODE, NCDFLG, DBGFLG R0:=^GOXX ...GOXX goes to XAdd in currently-set seg. end stk->flag; LDM R1,@R15,14; T Z; LDIRB @R7,@R3,R1 ...move text to buffer; ret with Z=1 if no text RESFLG Z; RET RESNSTe~ CALL RESNCD JR RESNST2 ... RESNST~ CALL RESNCD0 ...do FINCDGEN (FIXAREFS), res. NCODE if tmp NCODE RESNST2~ FREE:=^STACK ...res. STACK R3:=NCODE+1; RES R3,0;s brkpt) if CKBRKPT(LDL RR6,RPC_) zero then Step() end Go2~ LDL RR2,RPC_; LDL GO_PSPC,RR2 RFC_->GO_PSFC ...load prog. status vector LDL RR2,R14_; LDL XSP,RR2 ...RR14 must be loaded in seg. mode LDM R0,RRS_,14 ...regs. back JP STARTX ...starts eNGFLG:=4) := .DO(RL3:='B') LSTBRKS := .DO(RL3:='B') GETCNT := .DO(RL3:='X') BRKSOFF := .DO(RL3:='X') ? := .DO(RL3:='L') { / .DO(LDL RR2,LstDmp;R3:+1==R3)} .DO(PUSHall from Q0 -- look at system cmd buffer (@RR12) while RL0:=@RR12=' ' or RL0=' ' do R13:+1 RL0:=@RR12==0D; JR Z,START; RL0==';'; JR Z,START LDL RR10,RR12; R1:=0 repeat R11:+1; R1:+1==120; JR Z,ST4 until RL0:=@RR10=0D or RL0=';'; ST4~ POPL RR8 ...R8=myR15:+28; R0:<->@R15; RET *ZAPALL TMPS *PACKALL  brk used by SStep ...SBInst~ WORD 0 ...save inst. from above ...SSP~ WORD 0 SVs() ...reset NCODE, NCDFLG, DBGFLG R0:=^GOXX ...GOXX goes to XAdd in currently-set seg. end stk->flag; LDM R1,@R15,14;  R3->NCODE; RET ...make sure NCODE even ERRMCC~ LASTDE->R3 ...^ Error R3<->stk ...LASTDE (ptr. to error)->stack; length of text->HL PUSH R0 ...R.A contains CC ERMGET() ...get msg. & put into buffer CALL Copy; DEFT ' ERROR ' ...goes into buffer POP Rxecution /SEG RETDBG~ ...go to Debug, setting nonseg. & saving all regs. & flag ...also set SP if not in Q's stack LDRL RSAV,RR2; LDR RSAV+4,R4 R4:=flag R3:=R14; SET R3,15; RL3:=0; LDR R2,QSEG if R3<>R2 or R15<=(^MYSTAK+030) or R15>^MYSP then begin  table RELOTBX: WORD 0 ...index into reloc. table ...Skip: BYTE 1 ...if=0, skip line unless begins with "/" ...RTYPFLG: BYTE 0 ...set=1 if have symbols of REG type ...SCPFLG: BYTE 0 ...used by LABELCOL NUMERR~ BYTE 0 ...error count DIAGSW: BYTE 0 ... seg R9:=^DATA1+4 LDIRB @RR8,@RR12,R1 ...move sys. cmd buffer to my input buffer LDB @RR8,#0D LDL RR4,RR14; R9:=^MYSP; LDL RR14,RR8 ...set SP R3:=flag; RES R3,15; R3->flag ...04000->flag /NONSEG LDL SYSSP,RR4 R7:=^DATA1; CALL Copy; DEFT '/DO '; BYDL RR2,CDPTR; JR SETDLR DLRCDT: XLCDADR(LDL RR2,CDPTR); JR SETDLR DLRBSST: XLBSSADR(LDL RR2,BSSPTR) SETDLR~ LDL DOLLAR,RR2; R0==R0; RET SVDLR: SAVKL(LDL RR2,DOLLAR); RET SVHEXW := .SAV(OuthexW) ; SVHEXL := .SAV(OuthexL) ; ...save RL2,R3 in hex: SVHEXO 0 ...CC in R.A CALL Outhex ...puts out value of unsuccessful completion code JR ERR1 Errm: PROC ... PRINT MESSAGE AFTER CALL R3:=LASTDE R3<->stk ...LASTDE (ptr. to error)->stack; length of text->HL ERMGET() ...get msg. & put into buffer JR ERR1 ERM...set SP R3:=^MYSP; LDL RR14,RR2 end RES R4,15; R4:->flag ...set nonseg'd & restore flag byte /NONSEG LD R4,RSAV+4; LDL RR2,RSAV JP Debug GOXX~ R3->RSAV; R3:=flag; LD RSAV+2,R3 R3:=R14_; RL3:=0; SET R3,15 if R3=QSEG and R3:=R15_>^DBGSTK+030 and bit 2=1 for file writing ... bit 3=1 for diag output ... bit 6=1 for listing INLVL~ BYTE 0 ...level of input; 0=>from console, 1-5 =>from file IFLG~ BYTE 0 ...set=1 after first QINIT ...TMPTAB: BYTE 0[16] ...table to mark temp. symbols as used (=1) or TE 0 ...now /DO FILENAME in input buffer QINIT() ...R8=my seg. GETRCX(R7:=^DATA1) ...start of input buff.->DE->LASTCR->LASTDE JR ST3 ...call parser QINIT~ R8:->QSEG ... if BIT NCDSEG,15 zero then R8:->NCDSEG->RUNSEG INLVL:=0 ...file would be ma:= .SAV(.DO(PUSH R3;RL3:=RL2) OuthexB .DO(POP R3) OuthexW) ; ...COMM: ...INSTLIST: Del() ...RINST: ...RW0: ... RESFLG Z; RET *ZAPALL TMPS *PACKALL  p NOTCR)}} ... ?((LETTER / DIGIT) LFILOPN Outset O_VERSN Outp NOTCR)}} := "WRITE" { $(Del ","GET~ PUSH R3 ...save ptr. to text of error msg. STARS() ...to put out '***** ' POP R3 RL1:=@R3; RH1:=0 ...put length of message into BC R3:+1 LDIRB @R7,@R3,R1 ...move text into buffer RET Err0: RET Z ...flag must be not zero (enter here from rst) E R3<=^DBGSP then R15:=R3 else R15:=^DBGSP PUSH XAdd; PUSH NCDSEG LD R3,RSAV+2; R3->flag; R3:=RSAV JP GOX ResSVs~ RESNCD() RESDBF~ DBGFLG:=0; RET ...RESNCD~ NCDFLG==0; RET Z ... NCDFLG:=0 ...RETNCD~ W.SAVNCD->W.NCODE; RET ...ret. R3=NCODE ...OFFNnot (=0) TABBSE: WORD TABLE ...beg. of symbol table ENDTAB: WORD ENDTBL ...end of space allocated for symbol table ...EXTADR: WORD EXTEND ...gets addr. of EXTEND when defined, else 1 ...UCCADR: WORD USERCC ...gets addr. of USERCC when defined, else 1 LIrked open if Q imaged from file BtoQ0() ...set brks->Q if not set elsewhere if IFLG=0 then begin CALL INITTABS ...init. TABLE,CGTAB,BUFFER,REGNNO,RELOTBX end REQRELOTB() ...req. buffer from system for reloc. table IFLG:=1 RET RELOINIT: PROC .*SEG *CALR $+2;POPL RR2;LDCTL NSPSEG,R2; R3:=TABBSE;LDCTL NSPOFF,R3 ; 0100->TABBSE;R3:=05000;LD TABBSE+2,R3 ...move table /CLEAR ...initial values for location counters: CDPTR0: ADDR 2.0 ... 0.05000 ...later seg. 2 BSSPTR0: ADDR 2.08000 ... 0.0C000 /IF brr: PROC PUSH R7 ...ptr. to error STARS() ...put '***** ' into buffer ERR1~ Outmsg() ...add CR & send out R7:=^BUFF NUMERR:+1 ...increment error count R3:=LSTNCD; CALL HLout ...put out starting addr. of code for line if NOTASCFLG<>0 then begin RCD~ NCODE->SAVNCD; NCDFLG:=1; R3:+040->NCODE; RET ...ret R3=offset NCODE ...OFFNCD~ SAVENCD(); R3:+040->NCODE; RET ...ret R3=offset NCODE OFFNCD~ SAVENCD()->R3; SETCDPTR(R2:=NCDSEG; R3:+040) ...offset NCODE by 040 RET CKEND~ Del(); CPB @R7,#0D; RET ZNKAD: WORD 1 ...if bit 0 even, =addr of binary file linker SYSTEM~ PROC; SC SC_IO; RL0==080; RET ...test cond. code SYSTM~ PROC; SC SC_IO; RET SEEK~ PROC; SC SC_SEEK; RET FILLU0~ RL0:=INLVL FILLU~ ...get LU corres. to level RL0 ->RH0; save other regs., ..reset reloc. table index & req. relotab if none RELOTBX:=0 ... REQRELOTB: PROC ...request buffer for relocation table if RELOTBX=0 and TESTL RELOTB0 zero then begin R3:=RELOTBSZ; SC SC_MREQ if R3<>0FFFF then LDL RELOTB0,RR2 end RET RELRELOTB=len R3:->LASTDE R1:=^FILNM; LDIRB @R1,@R3,R5 B.0->@R1 RET GETFNM~ ...test if valid filename @R7, incing R7 ...if true, ret. Z=1, R3=beg, R5=len VALIDCHR(B.@R7); RET NZ PUSH R7 repeat R7:+1 until VALIDCHR(B.@R7) not; POP R3 if R5:=R7-R3<=MAXFNMLf where to image from while GET2W() not zero do begin ...go thru segment descriptors ...GET2W rets. R7=seg beg adr, R1=seg len PUSH R3 LDL RR2,@R6; R6:+4 ... R3:=R7; R2:=@R6' PUTO2() ...put out whole seg. POP R3 ...R3 pts to next seg. FPUTNX ...next open buffer space R3<->R7; LDIRB @R7,@R3,R1 ...text->buffer RH0:->flag if zero then PUTOUT() ...if buffer is exactly filled else begin R3<->R7 if ='0' and RL3<='9' or RL3:&0DF>='A' and RL3<='Z' then R0==R0 ... else RESFLG Z ... RET ...VALIDCHR~ ...test if RL3=valid char. for filename ... PUSH R3; VALIDCHR0(des. in buffer end POPL RR6; RET CLSIMGFIL: ...close image file CLFPT() ...close file; restore list file LU->vectors if RL0<>080 then WRTERR() RET ...Z=1 ...IMGSUB: ...do IMAGE (LASTDE=^filename) ... ...enter with segment descriptors & entry pt. a end R3->FPUTNX end POP R7; R0==R0; RET FINBUF: ...if list file open, put out BITB DIAGSW,2; RET Z ... R1:=FPUTRM; R3:=FPUTNX ...fill rem. buffer with spaces+CR ... repeat LDB @R3,#' '; R3:+1 until R1:-1 zero; ... R3:-1; LDB @R3,#0D ...fall thru do Getrec if INLVL=0 and DBGFLG<>0 then begin R15:=SAVSP; JP DBUG2 end ... Getrec: PROC ...enter with DE pointing after CR (or START) ...assure another CR in buffer if INLVL<>0 then begin ...chk if getting from file or console R3:=^DATA2 CPB @til RL0:=RL1&7 zero; RET end if RL0=0D then RL1:=0 ...begin RL1:=0; Put1(RL0:); RL0:=0A end else begin RL1:-1 if RL0<>8 then begin RL1:+2; if RL0<' ' or RL0=07F then RL0:='#' end end ... Put1: PROC ...put out 1 char. (in RL0) to console PUSHL); POP R3; RET Z ... RL3=='.'; RET Z; RL3=='_'; RET Z ... RL3=='/'; RET Z; RL3==':'; RET INVCHS: DEFM ';,<>=*"' ...<"> necessary because #include "filename" LINVCHS: EQU $-INVCHS BYTE 0 VALIDCHR: PROC ...test if RL3=valid char. for filename ...(systems go on descriptor ... ... record in FPUTBF ... PUSHL RR6 ... FTYP:=088; FPROPS:=0 ...set attr.; subtype bit 3=1 =>Z8000 ... R3:=DEFRL; LDB F_RL,RL3; LDB F_RL+1,RH3 ...RL=200 ... LO_ADD:=0 ...set LO_ADD to 0 so won't load on Z80 ... R3:=^SegDes; R4:=0 : ... PUTOUT: R1:=OUT_RL-FPUTRM; FPUTRM:=OUT_RL; R3:=^FPUTBF->FPUTNX; R2:=QSEG PUTO2: ...R1=len to write, RR2=addr R1==0; RET Z PUSH R1; PUSHL RR2 FILLU(RL0:=OUTLVL) SYSTEM(RL0:=WRT) POPL RR2; POP R1 RET Z PUSH R0 if OUTLVL=LFIL then DIAGSW:=0 ..R7,#EOFCH; JP Z,FILDUN ...check if at EOF CPB @R7,#EOF; JP Z,FILDUN R5:=R7 if R3:=R3-R7<=zero then begin ...chk if R7 in hi or low buffer ...in high buffer: R7:-IN_RL->R3; RES R3,0 R1:=(R1:=^DATA2-R3)/2 LDIR @R3,@R5,R1  RR0; RL0:=WRT; R1:=1 PUTGET~ RH0:=CONLU PUSHL RR2; R2:=0FFFF; R3:=R15+5 SYSTEM() POPL RR2; POPL RR0; RET ... Get1: PROC ...get 1 char. from console ->RL0 PUSHL RR0; R1:=1 GET1A~ RL0:=RD; JR PUTGET Get1if: ...get 1 char. from console if ready (Z=1 if may limit further) RL3==021; RET ULT; RL3==07E; RET UGT R5:=^INVCHS; R1:=LINVCHS; CPIRB RL3,@R5,R1,EQ; COMFLG Z RET TSTASC~ ...enter R3=^1st R5 bytes of file; chk if all ascii before EOFCH while R5<>0 do begin RL0:=@R3==EOFCH; RET Z RL0==EOF; R...get HI_ADD: ... while GET2W() not zero do begin ...go thru segment descriptors ... ...GET2W rets. R7=seg beg adr, R1=seg len ... if R7:+R1-1>R4 then R7:->R4 ... end ... RL4:<->RH4; R4:->HI_ADD ... OFILOPN(RL0:=LFIL+1; R1:=116) ...open output file .if list file, zero DIAGSW CLFPT() ...close output file without trying to empty buffer POP R0 WRTERR~ CALL ERRMCC; DEFT 'WRITE' CLFPT~ CLOSFL(RL0:=OUTLVL) ...close file; rets. RL0=cc ... RESLLU~ OUTLVL:=LFIL; RET ...restore list file LU#; save RL0  ...move remaining portion of high buffer to same rel. pos. in low LDL RR0,#IN_RL LDL RR4,FILPOS; ADDL RR4,RR0; LDL FILPOS,RR4 ...update file pos LDL RR2,#0FFFF,DATA2 ...R1=IN_RL READF() ...RDFIL2() ...fill high buffer end end el char.; Z=0 if no char.) PUSHL RR0; R1:=0; JR GET1A GetN~ PROC ... gets to CR, echoing, backspacing, storing @R7 (saves R7) read(CONLU,R7,IN_RL); RET ... R7:->R3; RL1:=0 ...RL1=col. ... repeat Get1() ...get byte ... if RL0=8 then begin ...if bacET Z BITB RL0,7; RET NZ R3:+1; R5:-1 end RET NEWFIL: PROC ...enter with DE at CR; input file name @FILNM+ (ends with 0) RL1:=INLVL==NLVLS; JP NC,TUDEEP ...files go to max level 5 INLVL:+1 ...inc. file level if RL1<>0 then begin ...if old le(7=LU level) ... R3:=^SegDes; R6:=^SegSegs2 ...beg. of descpts. of where to image from ... while GET2W() not zero do begin ...go thru segment descriptors ... ...GET2W rets. R7=seg beg adr, R1=seg len ... PUSH R3 ... LDL RR2,@R6; R6:+4 ...... R3:=LFILOPN: ...open list file; LASTDE pts. to filename followed by a delimiter OFILOPN(RL0:=LFIL; R1:=0) ...open output file with LU level=6 SETB DIAGSW,2 ...mark for file output RET OFILOPN~ RL0:->OUTLVL; ...PUSH R1 ...RL0=output file level, R1=#attr.se begin GETCNS~ ...reads in a line from $CON, rets. R7->1st char. RL0:=CPRMPT if NCDFLG<>0 then RL0:=IPRMPT Getcon: PROC ...come here with RL0=prompt char. Put1(RL0:) NUMERR:=0 ...zero error count GetN(R7:=^DATA1) ...get new chars; Dkspace ... RL1:+1; RL1:-1; JR Z,GetN ... PUSH R7; RL1:=0 ... repeat RH1:=RL1 ... if RL0:=@R7=9 then begin ... repeat RL1:+1 until RL0:=RL1&7 zero; RL1:-1 ... end ... R7:+1; RL1:+1 ... until R3=R7; ...get RH1=col. of prev. char. ... repe, vel not console RH1:=0 MULT RR0,#6 ...R1:*6 R6:=^POSTBL-6+R1 ...R6=^where to store current pos. R7:+1 ...move R7 past CR LDL RR2,FILPOS if R7>=^DATA2 then begin ...chk if in low or high buffer R7:-IN_RL ...if in high buffer, pt.R7; R2:=@R6' ... PUTO2() ...put out whole seg. ... POP R3 ...HL pts to next seg. des. in buffer ... end ... CLFPT() ...close file; restore list file LU->vectors ... if RL0<>080 then WRTERR() ... POPL RR6; R0==R0; RET INRELOC: PROC ...enter with RR ... GETFNM() ...filename & drive->@FILNM+ ... POP R1 ... LDL RR2,#0FFFF,FPUTBF LDL RR4,#0FFFF,FILNM SYSTEM(R0:=1*256+OPN) ...open output file if not zero then begin RESLLU(); JR OPNERR ...restore LU=list file in output vectors end STLU(RL0:=OUTE pts. to beg. of buffer end GETRCX~ R7:->LASTCR; R7:->LASTDE ...LASTDE needed in case Errm before set RL0==RL0; RET READFL~ ...enter with RR4=file pos to read at ...fill both low & high buffers FILLU0() ...LU->RH0 SEEK(RL3:=RH0; R1:=0) R1:=IN_RL*2at Echo(RL0:=8); Echo(RL0:=' '); Echo(RL0:=8) ... until RL1=RH1; R3:-1 ... POP R7; RL0:=8 ... end else begin RL0:->@R3; R3+1; PUSH R0; Echo(RL0:); POP R0 end ... until RL0=0D; ... RET Outmsg: PROC ...put to file if open + console (save regs>=R4 exc R7 to same rel. pos. in low ADDL RR2,#IN_RL end R7:->@R6; LDL R6[2],RR2 ...store old R7 (after CR) & file pos of buf end FILOPN() ...open file LDL RR4,#0; LDL FILPOS,RR4 ...init. file pos. (high byte=0 for abs.) ... NOTASCFLG:=1 ...for c2=target machine addr of addr ref (for ... relocation), R5=0 if code ref, =1 if data ref, bit 15=1 if external ... if external, bit 12=1 if init'n ref, bits 0-11=symtab ordinal ...save in reloc. table addr + code save R7..R11 LDL RR10,RR2; R7:=R5 if LVL) ...store LU# RET FILOPN~ ...open input file (store LU); call WRGTYP if not ascii PUSHL RR6 ... GETFNM() ... R1:=0 ...116 ...R1=#attr. ... LDL RR2,#0FFFF,BUFF LDL RR4,#0FFFF,FILNM SYSTEM(R0:=0+OPN); JR NZ,RESLU ...open input file RL6:=RH0; RH6 LDL RR2,#0FFFF,DATA1 READF: ...come here with RR2,R1 set FILLU0() ...LU->RH0 SYSTEM(RL0:=RD) RET Z; RL0==0C9; RET Z ...EOF error ok ... RDERR~ PUSH R0; Quit1() ...close files (return to console after CALL Err) POP R0; CALL ERRMCC; DEFT 'READ'; BYept R7 inc'd) RL0:=0D->@R7' ...put CR in buffer Outbuf: PUTFIL() ...put to file if one open Putcon: PROC ... print from ^BUFF to R7 R3:=^BUFF; RL1:=0 while R3RL0)==1; JP LT,RDERR ...read am't big enough for proc file header+segtab SEEK(R3:=R6; SUBL RR4,RR4; R1:=0) TSTASC(^BUFF,R7); JR NZ,WRGTYP POPL RR6 RET ... WRGTYP~ CLOSFL(RL0:=INLVL) ...TE 0 GET2W~ ...next 2 words @R3 go to R7 & R1, R3 inc'ed; R1 tested for 0 R7:=@R3'; RL7:<->RH7 R1:=@R3'; RL1:<->RH1 R1==0; RET OPNIMGFIL: ...open image file & write out attributes PUSH R7 ... FTYP:=088; FPROPS:=0 ...set attr.; subtype bit 3=1 =>Z800' or RL0=0D then begin ...'?' or CR stops printing repeat Get1(); P_ESC() until RL0='?' or RL0=0D; RET end P_ESC~ RL0==01B; RET NZ ...test for escape Quit1(); RESNST() ...poss. need to close files / res. NCODE/STACK JP Debug0 PUTREC: ...puts fromhis case, don't clobber DATA1,2 or LASTCR; ... ... else can use DATA1,2; ...should set LASTCR at text for Err ... JR Z,FILDN2 ... end ... JP WRGTYP ... end NOTASCFLG:=0 READFL() ...fill both low & high buffers R7:=^DATA1 ...pt. DE to start of bR2,RR8); R9:+2 WRR1aRR2(R1:=R11; LDL RR2,RR8); R9:+2 WRR1aRR2(R1:=R7; LDL RR2,RR8) RELOTBX:+RELOENTSZ end end restore R7..R11 RET ...********* /NONSEG JPNEW: ...start new program @RR2 (seg'd) with SP=SYSSP, RR12=Qseg,R7 ...also closclose file if not ascii or proc. RL0:=0D2 ...error code for invalid type RESLU~ INLVL:-1 ...restore old log. unit no. OPNERR~ CALL ERRMCC; DEFT 'OPEN'; BYTE 0 ...GETFNM~ ...get filename from @LASTDE->^FILNM + add 0 ... ...call OPNERR if invalid ... PUSH0 ... R3:=DEFRL; LDB F_RL,RL3; LDB F_RL+1,RH3 ...RL=200 ... LO_ADD:=0 ...set LO_ADD to 0 so won't load on Z80 ... R3:=^SegDes; R4:=0 ...get HI_ADD: ... while GET2W() not zero do begin ...go thru segment descriptors ... ...GET2W rets. R7=seg beg adr,  ^BUFF to R7 to file if open, else to $CON PUTFIL(); JR NZ,Putcon; RET PUTFIL~ ...if output file open, put to file, Z=1; else Z=0 BITB DIAGSW,2; COMFLG Z; RET NZ R3:=^BUFF PUTFILE: ...below puts from R3 to R7 ->file PUSH R7 R3<->R7 PUTLUP~ R3-R7->R1 uffer JP ST1 ...reset SP, get line of input & start parsing FILDUN: if RL0:=NUMERR<>0 then begin R7:=^BUFF; CALL Copy; DEFT "ERROR TOTAL="; BYTE 0 CALL Outhex; Outmsg() end FILDN2~ if RL0:=@(R5:=^INLVL)<>0 then begin CLOSFL(RL0:) ...close inpe files & restore BRKADR, SC_ADR PUSHL RR2; Quit(); BRKStoP(); RELRELOTB() POPL RR2; R12:=QSEG; R13:=R7 LDL RR4,SYSSP; R0:=0C040->flag /SEG LDL RR14,RR4; JP @RR2 /NONSEG RETSYS: ...ret. to system, closing files & setting seg'd Quit(); BRKStoP(); RELR R7 ... if GETFNM2(R7:=LASTDE) not then OPNERR(RL0:=046) ... ...R3=beg., R5=len ... R7:=^FILNM; LDIRB @R7,@R3,R5 ... B.0->@R7 ... POP R7; RET FILENM: PROC ...test for filename @R7 (inc R7); if true, put @^FILNM + add 0 GETFNM(R7:); RET NZ ...R3=beg., R5R1=seg len ... if R7:+R1-1>R4 then R7:->R4 ... end ... RL4:<->RH4; R4:->HI_ADD OFILOPN(RL0:=LFIL+1) ...; R1:=116) ...open output file (7=LU level) POP R7; RET PUTIMG: ...put out code image PUSHL RR6 R3:=^SegDes; R6:=^SegSegs2 ...beg. of descpts. o ...R1 gets length of text to be transfered R3:=FPUTRM ...space left in buffer if R3:-R1FPUTRM; R3:=ut file DECB @R5 ...decrement level end NOTASCFLG:=0 ...only top level can be non-ascii if RL1:=@R5<>0 then begin ...check if back to $CON or still a file RH1:=0 MULT RR0,#6 ...R1:*6 R6:=^POSTBL-6+R1 ...R6=^where to store current pos. - ELOTB() LDL RR4,SYSSP; 0C040->flag /SEG LDL RR14,RR4; RET /NONSEG BtoQ0~ ...set brks->Q if not set elsewhere RDBRKA() ...curr. value in system BRKRTN->RR2 BIT R3,0; RET Z; JR BtoQ2 ... BRKStoQ: BITB SCBFLG,0; COMFLG Z; RET Z ...brks already set->Q IST} FCALL2 ")" ; PRIMOP2 := $(Wh "[" OUTLOAD "]" DOARY / "->" Wh SVST_ID PTSTO_OP / ) ; DOTOP := "." Wh SVST_ID DOT_OP ; CONS := / / ; SIZEOF := Wh ( SVSZABTYP /0 then ZSZSTR() ...members must have size>0 if CKMOS() then R6:+@R9[SDSZ]->@R9[SDSZ] ...if struct else if R6>@R9[SDSZ] then R6:->@R9[SDSZ] ...if union end else begin ...BITFLD or BITFLD|08000 (size in hi-byte not bit 15) RL6:=RH0&07F ...RL6=ariables LDR R2,QSEG; R3:=R14; SET R3,15; RL3:=0 if R3<>R2 or R15<=(^MYSTAK+030) or R15>^MYSP then begin R3:=^MYSP; LDL RR14,RR2 ...set SP (leave if in Q's stk) end R3:=flag; RES R3,15; R3->flag ...04000->flag /NONSEG LDL RR6,RPC_ CPL RR6,STBADDB := "{" STDCL0 STDCL2 "}" ; STDECLST := $ ; STDEC := ; STRDECLST := ?( $(Wh "," )) ";" ; STRDEC := DCL0 { DCLBITF / DCLMOSU} := PADFLD ; BITFIELD := Wh ":" RR2 BtoQ2~ LDL BRTNSV,RR2 ...save it SETB SCBFLG,0 R2:=QSEG; R3:=^B_RTN; JR SETBR ...set brks->Q BRKStoP: BITB SCBFLG,0; RET Z RESB SCBFLG,0 LDL RR2,BRTNSV ...restore BRKRTN to prev. state SETBR~ WRBRKA();  SETOUTOFF SVSZFACT SETOUTON) ; CON := SAVFPTR "." GETFLT := ("0" (("x"/"X") HEXNUM / OCTNUM) / ) ?(("L"/"l") KSZL / ("."/"E"/"e") Ig GETFLT) := "'" "'" ; STRING := """ """ ; FARGLIST := ?( $("," )) ; size of bit field if RH0=0 or RL6>(SZINT*8) then begin ...RH0==0 =(R0&08000 zero and RL6=0) Errm(); DEFT 'BIT FIELD TOO BIG (OR 0) ' end if B.@R9[SDBITO]=0 then ALIGN(@R9[SDSZ],INT)->@R9[SDSZ] if RL6=0 or RL6+@R9[SDBITO]>(SZINT*8) then bt: JP OUT Sav: JP SAV Err0: JP ERR0 Re: JP RE Xc: JP XC Wh: JP WH EXPR := ENDEXPR ; EXPR0 := $(Wh "," ENDEXPRA ) ; EXPR1 := ( / ? {OTHEROPS}) := ; ASNMENT := Wh ( / ) OUTSTORE ; ASNEXPR> ; DECLIST := ?( $(Wh "," )) ";" ; DECL := DCLEXT ; PDECLIST := $(Wh "," ) ";" ; PDECL := DCLPARM2 ; DECL0 := DCL0 ; DECL2 := Wh "*" DCLPTR := ( .SAV(*) DCLNUL / "(" Wh ")") DER0==R0; RET WRBRKA~ R5:=0; SC SC_WRHDL; RET RDBRKA~ R5:=0; SC SC_RDHDL; RET O_VERSN: ...C version msg->@R7' R3:=^CVERS; R1:=LVERSN; LDIRB @R7,@R3,R1; RET RDaHL: PUSH R2; R2:=NCDSEG; RDaRR2(); POP R2; RET ...WRaHL: PUSH R2; R2:=NCDSEG; WRaRR2(); POP RFTNARG := (SVARGSPC {} RESARGSPC) STFTNARG ; PTYPNAMP := SVSTDCL { {ABSDECL} ")"} RESSTDCL ; ...back up before "(" if no TYPESP; get ABSTYP,ABSAGG ABSDECL := DCL0 SETABSTYP ; ABSDECL2 := Wh "*" {ABSDECL2} DCLPTR := { {egin ALNBFINT(R9)->R3 ...rets. R3=padding size in hi-byte (lo=0) if R3<>0 then R3->@R10' end RL0:=@R9[SDBITO]; R7:=@R9[SDSZ] ...for ret. if RL6<>0 then begin R1:=BITFLD; if CURTYP&08000 not zero then R1:=0 RH1:=RL6; R1:->@R10Q := OUTLOAD ; ASNOP := ("+=" SAVPL / "-=" SAVMN / "*=" SAVTMS / "/=" SAVDIV / "%=" SAVMOD / ">>=" SAVSHR / "<<=" SAVSHL / "&=" SAVAND / "^=" SAVXOR / "|=" SAVOR) DUPLVAL BINOP1 OUTBINOP ; OTHEROPS := $ $ $ DCLARY) ; ARRAYSUB := Wh "[" { / SAVZ} "]" ; ENUM := {Wh } Wh "{" $(Wh "," ) "}" TYPINT; MOEDEC := .SAV(*) Wh "=" DCLMOE ; 2; RET ...WRaDEi: PUSH R3; R3:=R7; WRaHL(); RL3:=flag; R7:+1; RL3:->flag; POP R3; RET ...RDBCaHL: PUSH R2; R2:=NCDSEG; RDR1aRR2(); POP R2; RET ...WRBCaHL: PUSH R2; R2:=NCDSEG; WRR1aRR2(); POP R2; RET ...WRDEaHL: PUSH R1; R1:=R7; WRBCaHL(); POP R1; RET RDaABSDECL2} Wh ")" / DCLNUL} DECLSUB ; ICONEXPR := CHKINT ; CONEXPR := ? ; C_EXPRQ := $ ; C_EXPROR := $ ; C_EXPRXOR := $ ; C_EXPRAND := $ ; C_EXP' ...store hi-byte=size, low=type (0=bitfpad) if RL3:=RL0+RL6>=(SZINT*8) then begin R7+SZINT->@R9[SDSZ] RL3:=0 end RL3:->@R9[SDBITO] end end R10:->@R8[SDPTR] R3:=R7; RL5:=RL0 restore R6..R10 R0==R0; RET ALNBFINT~ ...i> $ $ $ $ $ $ $ ? ; OPSQ := "?" OUTJPF OUTEXPR OUTRMV ":" EXC OUTJP EXC OUTLAB EXC OUTEXPR OPSQ2 ; OPS_OR := "||" OUTJPT SVLABL / OPS_AND ; OPS_AND := "&&" OUTJPF $(Wh "," ) ";" ; E_IDECL := DCLLOCAL ? ; E_INITER := Wh "=" ENDEXPR ; COMPDSTMT := "{" BLKENTRY $ $ BLKEXIT "}" ; PEXPRP := Wh "(" ")" ; STMT_0 := RELABAGG ; STMT :=RR2: ...RL0:=@RR2 PUSH R5; R5:=flag; SET R5,15; R5:->flag /SEG RL0:=@RR2; JR RWaRX ... /NONSEG WRaRR2: ...RL0->@RR2 PUSH R5; R5:=flag; SET R5,15; R5:->flag /SEG RL0:->@RR2; JR RWaRX ... /NONSEG RDR1aRR2: ...R1:=@RR2 PUSH R5; R5:=flag; SET R5,15; R5:->REQ := $ ; C_EXPRLT := $ ; C_EXPRSH := $ ; C_EXPRAD := $ ; C_OPSQ := "?" .SAV(Xc Re Re) ":" .SAV(Xc Re Re"?"Calc); C_OPSOR := .SAV("|") Snc. SDSZ @R3 to end of int. with current bit offset @R3[SDBITO] ...ret. padding size in hi-byte of R3 (lo=0) R1:=R3; R0:=0 if B.@R1[SDBITO]<>0 then begin RH0:=(SZINT*8)-@R1[SDBITO] @R1[SDSZ]+SZINT->@R1[SDSZ] B.0->@R1[SDBITO] end R3:=R0; RET PR_AND> SVLABL / OPSOR ; OPSOR := SAVOR BINOP1 OUTBINOP / OPSXOR ; OPSXOR := "^" SAVXOR BINOP1 OUTBINOP / OPSAND ; OPSAND := SAVAND BINOP1 OUTBINOP / OPSEQ ; OPSEQ := ("==" SAVEQ / "!=" SAVNE) BINOP1 OT STORTYP: ...store type from CURTYP at NXTSTPOS=AGGDCL0[DCLLVL-1].SDPTR ... (if buffer full, continue buffer is @SDPTR instead) ...if array/struct/union, also store ^ from CURAGG ...if lo-byte of CURTYP=BITFLD, size is in hi-byte except bit 15; bit .flag /SEG R1:=@RR2; JR RWaRX ... /NONSEG WRR1aRR2: ...R1:->@RR2 PUSH R5; R5:=flag; SET R5,15; R5:->flag /SEG R1:->@RR2; JR RWaRX ... /NONSEG LDIRB_: ...LDIRB @RR6,@RR2,R1 PUSH R5; R5:=flag; SET R5,15; R5:->flag /SEG LDIRB @RR6,@RR2,R1 RWaRX~ RES R5,15- VBINCALC := C_OPSXOR ; C_OPSXOR := "^" .SAV("^") SVBINCALC := C_OPSAND ; C_OPSAND := .SAV("&") SVBINCALC := C_OPSEQ ; C_OPSEQ := ("==" .SAV("=") / "!=" .SAV("#")) SVBINCALC := C_OPSLT ; C_OPSLT := C_OPSSH ..GETSZ: ...enter with R3=type, R5=aggptr of object ...get size of object->R3; err if is struct not all defined yet or func R0:=R3; R1:=R5 if R3:=R3&TMASK zero then begin if R0:&BTMASK=STRT or R0=UNIONT then begin if BITB SDFLG[R1],INDEFB not zeroUTBINOP := OPSLT ; OPSLT := OPSSH ...chk << before <= := ("<=" SAVLE / ">=" SAVGE / "<" SAVLT / ">" SAVGT) BINOP1 OUTBINOP ; OPSSH := ("<<" SAVSHL / ">>" SAVSHR) BINOP1 OUTBINOP := OPSAD ; OPSAD := ("+" SAVPL / "-" SAVMN) BINOP1 size is just padding (0=>end of int); store size (hi-byte), ... type (lo): type=BITFLD or 0 in case of padding ...if type=0, align to ALSTRUCT & store out 0 ...also update struct size in SDSZ (of 1st buffer) ...ret. R3=SDSZ after alignment & ; R5:->flag /NONSEG POP R5; RET ... ...LDIR_: ...LDIR @RR6,@RR2,R1 ... PUSH R5; R5:=flag; SET R5,15; R5:->flag .../SEG ... LDIR @RR6,@RR2,R1; JR RWaRX .../NONSEG *ZAPALL TMPS *PACK ALL  00 ' ...C version no. (11/18/82) LVERSN~ EQU $-CVERS ...the fol.chk << before <= := ("<=" .SAV("[") / ">=" .SAV("]") / ("<" / ">") .SAV(*)) SVBINCALC ; C_OPSSH := ("<<" .SAV("{") / ">>" .SAV("}")) SVBINCALC := C_OPSAD ; C_OPSAD := ("+" / "-") .SAV(*) SVBINCALC := C_OPSML ; C_OPSML then begin Errm(); DEFT 'SELF REF ' end R3:=@R1[SDSZ] end else R3:=SZBTYP[R0] end else begin if R3=FTN then begin ILLFTN~ Errm(); DEFT 'ILLEGAL FUNC DECL' end if R3=PTR then R3:=SZPOINT else R3:=@R1[SDSZ] ...if ARY ePRAD> OUTBINOP := OPSML ; OPSML := Wh ("*" SAVTMS / "/" SAVDIV / "%" SAVMOD) BINOP1 OUTBINOP ; ... EXPRRT := ? ; EXPRQ := $ ; EXPR_OR := $ ; EXPR_AND := $ ; EXPROR := $before update ...if bitfield, also ret. RL5=bit offset as above save R6..R10 R8:=AGGDCL0[DCLLVL-1]->R9 while BITB SDFLG[R8],CONTB not zero do R8:=@R8[SDPTR] R10:=@R8[SDPTR] if R10-R8>=(STDCTBSZ-2) then begin ...if doesn't fit in buffer if zero th R1; StepSP(); POP R1 ...do Step & comp. R_SP to orig. ... RET NC ...if R_SP>=orig. R_SP ... until RH1:-1 zero; ... W.SAVADR; B.RDaHL()->SBInst ...store inst from @(ret. addr.) ... if PutBrkW() zero then begin ...put out 0E00; Z=0 =>rom ... R3->SBA := Wh ("*" / "/" / "%") .SAV(*) SVBINCALC ; C_FACT := Wh ("-" .SAV("n") / ("~" / "!") .SAV(*)) .SAV(Re Re Calc) := := "(" ")" := ; ...SVBINCALC := .SAV(Re Re) .SAV(Xc Re Re Calc) ; DECLAR := INITDCL Wh (nd RET ALIGN: ...enter with R3=current offset, R5=type ...ret. R3=offset aligned for type save R8,R9 R8:=R3; R9:=R5->R0 while R3:=R0&TMASK=ARY do SRL R0,2 if R3=0 then R0:=ALBTYP[R9&BTMASK] else begin R0:=ALPOINT if R3=FTN then R0:=ALFTN end ; EXPRXOR := $ ; EXPRAND := $ ; EXPREQ := $ ; EXPRLT := $ ; EXPRSH := $ ; EXPRAD := $ ; FACT := Wh "&" DOPTRTO := "++" DOINC := "--" @R10 GETSTTB0() ...get another buffer; R3 pts to R3->@R8[SDPTR]->R10 SETB SDFLG[R8],CONTB ...mark continue in another buff. R8:=R10 R10:+SDHDRL ...pt. R10 past header end R0:=CURTYP if R0=0 then begin ...if end of struct/union ddr; R15:->SSP ...set special brk; save SP ... JP Go ...go ... end ...SStep3: repeat StepSP() until >=zero; ...do Steps until R_SP>=orig. R_SP ... RET ...SBRET~ ...come here after sp. brkpt (used by SStep) hit ... R15:=SSP ... ...ResSBrk~ ...reset s SCEXT {TYPESP_I} / SCTYPDEF ) := ; DECLSP := {TYPESP_I} / SCAUTO ; SC_SP := SCREG / SCSTAT / SCAUTO ; TYPESP_I := / TYPINT ; TYPESP := Wh DODEC := "-" DONEG := "~" DOCPL := "!" DONOT := SVSTABTYP DOTYPCAST := ? := ; POSTOP := Wh "++" DOPSTINC / "--" DOPSTDEC ; LVAL := / "*" DOINDR ; PRIM0 := Wh ( ALIGN(@R9[SDSZ],STRT)->@R9[SDSZ]->R7 0->@R10' end else if RL0<>BITFLD then begin ...note: chking lo-byte only R7:=0 ...offset for members of union always 0 if CKMOS() then begin ...if member of struct: ALNBFINT(R9)->R3 ...rets. R3=paddpecial break used by SStep ... LDL RR2,SBAddr; R3==0FFFF; RET Z ... ResINST(R1:=SBInst); LD SBAddr+2,#0FFFF; RET /SEG B_RTN: ...control goes here after break (PC,FCW on stk) ...(written so can run on any seg.) PUSHL RR2 LD R3,RR14[6]; LDR RFC_,R3 ...ESP0> ; TYPESP0 := TYPCH Wh ? / TYPINT {UNSGN} := TYPFLT / TYPDBL := ( TYPSH {UNSGN} / Wh { TYP_ULG / TYP_USH / TYPCH / TYPUINT}) Wh ? := Wh { TYPLGURTYP,CURAGG set, Id on STACK DCLEXTI0() SAVlD(); OUTlab() RET DCLEXTI0~ ALIGNI(CURTYP); LDL RR2,DNCODE DCLSYM0() R3:=SYMPTR; SET SFLAGS[R3],CDREGB ...mark in code region RET DCLEXTF: ...declare external function in prog. region ...enter with CU SVST_ID {PRIMOP} / .SAV(*) "(" DCLEXTNF SVST_ID {PRIMOP2}) := ")" {PRIMOP} ; PRIM1 := SVSTCON := DOSTRING ; ...SVSTSTR ; PRIMOP := Wh "(" {PRIMOP2} := {PRIMOP2} ; FTNCALL := FCALL0 {FARGLing size in hi-byte if R3<>0 then R3->@R10' ...if were in bitfield, pad to end of int. ALIGN(@R9[SDSZ],CURTYP)->@R9[SDSZ]->R7 ...align SDSZ for CURTYP end CURTYP->@R10' if R1:=CURAGG<>0 then R1:->@R10' R6:=GETSZ(CURTYP,R1) if R6=get & store FCW LDL RR2,RR14[8]; LDRL RPC_,RR2 ...get & store PC LDCTL R3,NSPSEG; LDR N14_,R3 ...nonseg R14 POPL RR2 R15:+8; LDRL R14_,RR14 ...save adjusted RR14 LDRL R12_,RR12; LDR R12,QSEG; R13:=^RRS_ LDM @RR12,R0,12 ...store rest of regs. in v {UNSGN} / TYPDBL / TYPLG {UNSGN}} := := := ; UNSGN := Wh ?( TYPU) ; STRCTUNSP := ( TYPSTR / TYPUN) Wh ( ( / .SAV(*) DCLTAG Wh ) / GETSTTB ) ; STDECLST. RTYP,CURAGG set, Id on STACK DCLEXTI0() ... SUBL RR2,RR2 ... DCLSYM0() SAVlC(); OUTlab() RET DCLEXTU: ...declare external object in uninit'd data region & reserve space ...enter with CURTYP,CURAGG set, Id on STACK ALIGNU(CURTYP); LDL RR2,BNCODE DCLSL5<>'K' then WRGTYP() end RL1:=BITO; RH1:=0 ... RL1:=(SZINT*8)-BITO-RL6; RH1:=0 SDL R3,R1; R3|BITFVAL->BITFVAL if BITO:+RL6>=(SZINT*8) then begin R2:=0 OUTDTA(BITFVAL,SZINT) BITO:=0; BITFVAL:=0 INCISZ(SZINT) ...inc ILVLSZ end restore R6, ...RR8:*16 RH3:=0; R2:=0; ADDL RR8,RR2 ...RR8:+RL3 end KTYP:=INT if CPL RR8,#MAXINT >zero then KTYP:=UINT if CPL RR8,#MAXUINT >zero then KTYP:=ULONG SAVKL(LDL RR2,RR8) POPL RR8; RET OCTNUM: PROC ...get & save octal digit string or 0 ...also rVL:+1 R9:=@R9[SDPTR]->AGGP[ILVL] 0->ILVLSZ[ILVL] SRL R10,2 R10&(-BTMASK-1)+(R8&BTMASK)->ITYP[ILVL]->R8 end if R3<>0 then begin if R3=FTN then ILLFTN() ...else ptr end else begin R3:=R8&BTMASK ...mask because BITMAXINT: EQU 2**(SZINT*8-1)-1 MAXUINT: EQU 2**(SZINT*8)-1 ...offsets of label data entry: L_SC: EQU 0 ...TLABEL/FLABEL L_LINK: EQU 2 ...link L_N: EQU 4 ...label snum LABENTL: EQU 6 MAXLUPLVL: EQU 16 ...max. level of nesting of loops MAXSWLVL: EQU 8 .YM0() SAVlB(); OUTlab() GETSZ(CURTYP,CURAGG)->R3; R2:=0 LDL RR0,RR2; ADDL RR0,BNCODE; LDL BNCODE,RR0 OUTUSZ() RET SAVlD~ := .SAV("lD") ; SAVlB~ := .SAV("lB") ; SAVlC~ := .SAV("lC") ; OUTUSZ~ := SVHEXO .OUT("U"Re) ; OUTlab0~ := .DO(PUSH R3) .OUT(Re .R7 RET INITU~ ...allows union to be inited with 0 only; entered with R3=UNIONT save R8 R8:=R3 ALIGNI(R3)->R3; INCISZ(R3) GETSZ(R8,AGGP[ILVL])->R3->R8; INCISZ(R3) ReV() ...get value of item on STACK->RR2, tag->RL5 if RL5<>'K' or TESTL RR2 not zero et. KTYP=UINT or =ULONG if value>max unsigned int. PUSHL RR8; SUBL RR8,RR8 while DIGIT() do begin SLLL RR8,#3 ...RR8:*8 RH3:=0; R2:=0; ADDL RR8,RR2 ...RR8:+RL3 end KTYP:=INT if CPL RR8,#MAXINT >zero then KTYP:=UINT if CPL RR8,#MAXUINT >zero tFLD uses hi-byte if R3=STRT then begin INCPOSPD() ILVL:+1 0->ILVLSZ[ILVL] R9:->CURBASE[ILVL] R9:+SDHDRL->POSPTR[ILVL] JP INXT1S end end IFLG:=1 end restore R8..R10 RET CKILVLDUN~ ...if init leve..max. level of nesting of switch stmts SWHDRSZ: EQU 6 ...size of SWTAB header SWTABSZ: EQU SWHDRSZ+6*10 ...must=SWHDRSZ+mult of 6 (each entry=6 bytes) ...offsets of SWTAB header: DEFLTFLG: EQU 0 ...=1 if have default case SW_CNT: EQU 1 ...count*6 of DO(POP R3) OuthexW) ; OUTlab~ OUTlab0(@SYMPTR[SNUM]); RET INIT0: ILVL:=0; BRCLVL:=0; BRCLVLI:=0; NSTR:=0 R1:=SYMPTR @R1[TYPE]->ITYP[0]; @R1[AGGPTR]->AGGP[0]; B.0->ILVLB[0] RET INITLBR: if BRCLVL:+1>=MAXBRCLVL then TUDEEP() B.0->ILVLB[BRCLVL]; RET then begin Errm(); DEFT 'UNION INIT<>0' end repeat OUTDTA(B.0,1) until R8:-1 zero; restore R8 RET INCPOSPD~ ...inc POSPTR past both type & aggptr R0:=4; JR INCPOSP2 ... INCPOSP~ ...inc POSPTR past type R0:=2 INCPOSP2~ R0:+POSPTR[ILVL]; R1:=CURBAhen KTYP:=ULONG SAVKL(LDL RR2,RR8) POPL RR8; RET CHKINT: ...call WRGTYP if value on STACK<>int ReK(); if RL5<>'K' then WRGTYP() SVVAL(); RET SAVFPTR: ...save R7 in FPTR R7:->FPTR; RET GETFLT: ...enter with floating pt. string @FPTR ...get value & l done, dec ILVL, inc ILVLSZ of level below ...if to 0, set ILVL=-1 if ILVL=0 then ILVL:-1 else begin R1:=@(AGGP[ILVL-1])[SDSZ] if R1<>0 and R1<=ILVLSZ[ILVL] then begin ...0=>len of init will set if not zero then stop ...$$$ shouldn't happeno. of cases in SWTAB (each one) SW_PTR: EQU 2 ...if<>0, = ^to next SWTAB (same level) DEFLT_N: EQU 4 ...label no. of default case ...each entry of SWTAB={long VALUE; word snum} KTYP: WORD 0 ...size (type) of constant FPTR: WORD 0 ...save beg. of floaINITRBR: ...finish init'n for level of right brace, filling with 0 if BRCLVLI>=ILVLB[BRCLVL] do FINZ() BRCLVL:-1; BRCLVLI:-1 R0==R0; RET FINZ~ ...if size (of array) not set, set it; else init next SE[ILVL] if R0-R1>=(STDCTBSZ-2) then begin R0:=@R1[SDPTR]->CURBASE[ILVL] R0:+SDHDRL end R0:->POSPTR[ILVL] RET INCISZ~ ...inc. ILVLSZ[ILVL] by R3 R3+ILVLSZ[ILVL]->ILVLSZ[ILVL]; RET ALIGNU~ ...align BNCODE for type R3; put out "Unnnnnn" for any save on STACK; set KTYP ...ret. R7 at end of string; call WRGTYP if can't do R7:=FPTR->LASTDE ASCFLT(R7) ...->RR2 if not zero then WRGTYP() SVVAL(RL5:='f'); KTYP:=DOUBLE repeat ...pass string if DIGIT() not then begin if B.@R7='.' then begin ILVL:-1 INCISZ(R1) JR CKILVLDUN end end RET OUTDAT0~ ...output data from STACK for type ITYP[ILVL] ...update ILVLSZ & POSPTR R3:=ITYP[ILVL] if R1:=R3&BTMASK=BITFLD then begin OUTBITF(RL3:=RH3; RL5:=1) ...RL3=size, RL5<>0 INting pt. string ARGSPC: WORD 0 ...space required for args. ARGSPCSN: WORD 0 ...snum associated with "s" & "C" outs ...the following used by ReST to ret. state values: ST_TYP: WORD 0 ST_AGG: WORD 0 ST_N: WORD 0 ST_VAL: LONG 0 ST_SC: BYTE 0 STLEN: EQU $-Sitem to 0 R1:=AGGP[ILVL-1] if @R1[SDSZ]=0 then begin ...this should only be if array ILVLSZ[ILVL]->@R1[SDSZ] CKILVLDUN() end else begin IFLG:=0 INXT1() if IFLG<>0 then begin SAVZ(); INXT2() end end RET FININIT: ...finish all iskipped space save R8,R9 R5:=R3; LDL RR8,BNCODE ALIGNL(LDL RR2,RR8; R5:) ...->RR2 LDL BNCODE,RR2; SUBL RR2,RR8 if TESTL RR2 not zero then OUTUSZ() restore R8,R9 RET ALIGNI~ ...align IDATA NCODE for type R3; fill any skipped space with 0 ...ret. R3n R7:+1; R0==R0 end else begin if B.@R7&0DF='E' then begin R7:+1 if RL3:=@R7='+' or RL3='-' then R7:+1 R0==R0 end end end until not zero; R0==R0; RET SVSTACC: ...save state with type R3, aggptr R5, STSC=ACC, STN,vall,valCPOSP() end else if R3=UNIONT then begin INITU(R3) ...note: am allowing union to be inited with 0 INCPOSPD() end else begin OUTDAT(R3) INCPOSP() end RET OUTDAT: ...enter with R3=type (scalar); align (fill with 0) & output value ... from T_TYP BYTE 0 ...the following get values of 2nd state: ST_TYP2: WORD 0 ST_AGG2: WORD 0 ST_N2: WORD 0 ST_VAL2: LONG 0 ST_SC2: BYTE 0 STSC: BYTE 0 ...to pass sclass to SVSTATE STN: WORD 0 ...to pass snum to SVSTATE ...the following 2 bytes go together (nit'n with 0; then put out strings if any while ILVL>>0 do FINZ() OUTSTRGS() R0==R0; RET INITNXT: ...enter with value to init. next scalar item with on STACK TONXTI() INXT2() R0==R0; RET FIXBRLVL~ ...got to scalar item; set level for braces R1:=BR. =space skipped save R8 R5:=R3 ALIGNL(LDL RR2,DNCODE; R5:) ...->RR2 SUBL RR2,DNCODE; R8:=R3 OUTZ(R3) ...incs DNCODE R3:=R8 restore R8 RET ALIGNL~ ...do ALIGN but input & output offsets are long if R3>08000 then begin R3:-08000 PUSH R2 ALh=0 STSC:=ACC; STN:=0; SUBL RR0,RR0 ... SVSTATE: ...enter with R3=type, R5=aggptr, RR0=value(hi/lo), STSC=sclass, ... STN=snum; save state Outset() INS_W(R3); INS_W(R5); INS_W(STN); INS_L(LDL RR2,RR0); STSC->@R7' Sav(); RET CKDEC: ...chk if last id STACK in IDATA area ...update ILVLSZ[ILVL] by am't moved (alignment+size) save R8,R9 R8:=R3 ALIGNI(R3)->R3; INCISZ(R3) GETSZ(R8,0)->R3->R9; INCISZ(R3) ReV() ...get value of item on STACK->RR2, tag->RL5; poss. snum->R1 ...if='a', =>addr ref + offsetmp storage used by SVOPTYP): SV2BF1: BYTE 0 SV2BF2: BYTE 0 BINOP: BYTE 0 ...tmp. store binary operator NLUPS: BYTE 0 ...level of nesting of loops LUPLVL: WORD 0 ...level of nesting of loops+switch stmts BRKLAB: WORD ARRAY 0[MAXLUPLVL] ...break labelCLVL; R0:=ILVL while R1>BRCLVLI do begin RL0:->ILVLB[R1] if RL0>ILVLB[BRCLVLI]+1 then RL0:-1 R1:-1 end BRCLVLI:=BRCLVL RET TONXTI~ ...go to next scalar IFLG:=0 repeat INXT1() until IFLG<>0; RET INXT2~ ...INXT1 went to scalar; fix brace leIGN(R3,R5)->R3 POP R2 ADDL RR2,#08000 end else ALIGN(R3,R5) RET ALCODE: ...align (fill with 0) till aligned as for ftn ALIGNI(FTN+INT) RET OUTHEXB: ...put out byte value saved on STACK ReK() ...value->RR2 OUTDTA(R5:=1) RET OUTZ~ ...put outis declared; ret. SYMPTR @entry if so LKID(); RET SVST_ID: ...save state of symbol @SYMPTR; also mark ref'd R3:=SYMPTR; RES SFLAGS[R3],REFB SVSTSYM(R3); RET SVSTSYM: ...enter with R3 pointing to symtab entry ...save type,aggp,sclass,(offset/value/snut R0:=R8&BTMASK if RL5='K' then begin ...'K'/'f' if R0=FLOAT or R0=DOUBLE then WRGTYP() OUTDT2~ OUTDTA(R5:=R9) end else begin if RL5='f' then begin if R0<>FLOAT and R0<>DOUBLE then WRGTYP() JR OUTDT2 ... $$$ Note $$$ ... for no (snum) for each loop CONTLAB: WORD ARRAY 0[MAXLUPLVL] ...ditto continue label FTNTYP: WORD 0 ...saves type of current func. FTNAGG: WORD 0 STRRETLAB: WORD 0 ...label of buffer for struct. ret'd from func. RETLAB: WORD 0 ...label of ret. sequence SWLvel; put out data from STACK ...adjust POSPTR, ILVLSZ; chk if ILVL done FIXBRLVL() OUTDAT0() CKILVLDUN() RET INXT1: ...go to scalar or padding item; if scalar, set IFLG (cnt union=scalar) ... if padding, go past & chk if ILVL done ...adjust ILVL,IT R3 bytes of 0 PUSH R6; R6:=R3+1 while R6:-1 not zero do OUTDTA(0,1) POP R6; RET OUTDTA: ...put out in R5 bytes value in RR2; update DNCODE (not if in sizeof) save R8..R10 LDL RR8,RR2; R10:=R5 if CKOUTON() then begin R1:=R10; R0:=0; ADDL RR0,DNCOm+offset) on STACK ...if sclass=static/extern, use extdef PUSH R8; R8:=R3 if RL0:=@R8[SCLASS]=STATIC or RL0=EXTERN or RL0=EXTDEF then begin STSC:=EXTDEF; STN:=@R8[SNUM]; SUBL RR0,RR0 end else begin if RL0=LABEL or RL0=ULABEL then WRGTYP() RL0:w, put float out straight ... if want different float format, must change to "Ifeeffffff" form end ...if 'a': if R0:=R8&TMASK<>PTR then WRGTYP() R9:=R1 SVHEXO() ...save offset SVHEXW(R9) ...snum OUTIpRe2() ...OUTIpSNV(R5:=R1) ..VL: WORD 0 SWTABP: WORD ARRAY 0[MAXSWLVL] ...^'s to SWTABs of each SWLVL ...************** KSZL: if KTYP=INT then KTYP:=LONGT if KTYP=UINT then KTYP:=ULONG RET NUM: PROC ...get & save value of digit string; ret NZ if none ...also ret. KTYP=INT or =YP,AGGP,CURBASE,ILVLSZ,POSPTR,BRCLVLI,ILVLB save R8..R10 if ILVL=-1 then begin Errm(); DEFT "TOO MANY INIT'S" end INXT1S~ R8:=ITYP[ILVL]; R9:=AGGP[ILVL] if ILVL<>0 then begin R1:=AGGP[ILVL-1] if BITB SDFLG[R1],ARYB zero then begin ...if in structDE; LDL DNCODE,RR0 end OUTDVAL(LDL RR2,RR8; R5:=R10) restore R8..R10 R0==R0; RET OUTDVAL~ := .OUT("I"OUTVAL) ; ...put out in R5 bytes value in RR2 OUTVAL~ RL5:+'0'->@R7' case RL5: of '1': OuthexB() '2': OuthexW() '4': OuthexL() end RET ->STSC; STN:=0; LDL RR0,R8[HIVAL] end SVSTATE(@R8[TYPE],@R8[AGGPTR]) POP R8; RET SVSTCON: ...enter with value of const on STACK, KTYP=type ...save state ReK(); LDL RR0,RR2 STSC:=CONST; STN:=0 SVSTATE(KTYP,0) RET LEN: ...ret. R3=len of string @R3 . .OUT("Ip"snum offset) R3:=SZPOINT; R2:=0; ADDL RR2,DNCODE; LDL DNCODE,RR2 ...DNCODE:+SZPOINT end restore R8,R9 RET OUTIpRe2~ := .OUT("Ip"Re Re) ; OUTBITF~ ...enter with RL3=size of bitfield, RL5=0 if to just pad, else ... value to put out is oLONGT if value>max signed int. R7:->LASTDE DIGIT(); RET NZ PUSHL RR8; SUBL RR8,RR8 repeat ADDL RR8,RR8; LDL RR4,RR8 ADDL RR8,RR8; ADDL RR8,RR8; ADDL RR8,RR4 ...RR8:*10 RH3:=0; R2:=0; ADDL RR8,RR2 ...RR8:+RL3 until DIGIT() not zero; KTYP:=I R1:=POSPTR[ILVL] ...R10 R8:=@R1->ITYP[ILVL]; R9:=@R1[2]->AGGP[ILVL] ...get stored type & aggptr & set end end R3:=R8 ...type if RL3=0 then begin ...padding or end of struct if RH3=0 then begin ...end of struct (align to bdy) STRINIT: ...enter with string stored in req'd buffer, ^ to it saved on STACK ... (form ("S"ptr)) ...if next item=char, put out string as init'n, rel. buff ...if next item=^char, make ref. to tmp. symbol & put ^symtab entry ... in STRTAB (symtab pts. to R1:=R3; R0:=0 repeat R0:+1 until B.@R1'=0; R3:=R0; RET ...SVSTSTR: ...enter with ^string in buffer on STACK ... ...get snum; put out string in idata area; save state (sclass=STATIC) ... save R8..R9 ... ReV()->R3->R8 ... LEN(R3)->R3 ...get length of stn STACK ...current offset is in BITO; update ILVLSZ[ILVL] & BITO save R6,R7 R6:=R3; R7:=R5 if BITO=0 then begin ALIGNI(INT)->R3 INCISZ(R3) ...inc ILVLSZ BITFVAL:=0 end R3:=0 if RL7<>0 then begin ReV()->R3 ...value->R3, tag->RL5 if RNT if CPL RR8,#MAXINT >zero then KTYP:=LONGT SAVKL(LDL RR2,RR8) POPL RR8; RET HEXNUM: PROC ...get & save hex digit string or 0 ...also ret. KTYP=UINT or =ULONG if value>max unsigned int. PUSHL RR8; SUBL RR8,RR8 while HEXD() do begin SLLL RR8,#4 ALIGNI(STRT)->R3; INCISZ(R3) end else begin ...if padding RL3:=RH3 ...RL3=size in bits OUTBITF(RL3,B.0) ...0=>just pad end INCPOSP() CKILVLDUN() end else begin R10:=R8 while R3:=R10&TMASK=ARY do begin INCPOSPD() IL string) save R6..R9 TONXTI() ReV()->R8->R9 ...recall string ptr if ITYP[ILVL]=CHAR then begin ...if initing char array INITLBR() ...fake left brace RL6:=@R8' SAVKW(RL6; RH3:=0) INXT2() while RL6<>0 do begin TONXTI() if ITYP/ ring ... GETDIMTB(R3)->R9 ...get dimtab & fill in for array ... MAKSNUM()->R3->STN ... OUTSTRG(R3,R8) ...put out label & string in idata area ... SUBL RR0,RR0; STSC:=STATIC ... SVSTATE(ARY+CHAR,R9) ... restore R8..R9 ... R0==R0; RET DOSTRING: ...enter w end RET DOT_OP: ...enter: on STACK=state for mos/mou; below that another state ... (should be lval); combine for "." op ReST(); XFST() ...recall & transfer state to 2nd set of vars. ReST() R0:=ST_TYP if RL0=BITFLD or CKLVAL(R0,ST_SC) not zero theize of item to put out "D"uplicate for ... SV1(RL3:+'0') ... OUTDRe() ... RET RESVST: ...save state from vars. ret'd from ReST STN:=ST_N; STSC:=ST_SC; LDL RR0,ST_VAL ...R0:=ST_VALH; R1:=ST_VALL SVSTATE(ST_TYP,ST_AGG) RET RESVST2: ...save state from 2nXTDEF then SVSTSZ() ...save size/type char else SV1(B.'p') RET OUTAUTO1: ...save stuff for OUTLOAD or OUTSTORE of auto SVSTOFF() ...save offset incl. bitfld size,offset, str. size SV1(B.'f') if ST_SC=AUTO then SVSTSZ() ...save size/p/s/b else SV1type ...either ST_TYP/ST_TYP2=ptr; ret. R3=result type, R5=result aggptr if ST_TYP&TMASK=PTR then begin DECREF(ST_TYP)->R3 GETSZ(R3,ST_AGG)->R3 SVHEXO(R3; R2:=0) if ST_TYP2&TMASK=PTR then begin SVp_() SVp_() SVOPTYP(INT) Rith ^string in buffer on STACK ...get snum; put out string in idata area with jp around ...save state (sclass=STATIC) save R8..R10 OUTJP(); EXC() ReV()->R3->R8 LEN(R3)->R3 ...get length of string GETDIMTB(R3)->R9 ...get dimtab & fill in for array n WRGTYP() ...just chk lo-byte of bitfld STN:=ST_N; STSC:=ST_SC; LDL RR0,ST_VAL; ADDL RR0,ST_VAL2 SVSTATE(ST_TYP2,ST_AGG2) RET PTSTO_OP: ...enter: on STACK=state for mos/mou; below that another state ... (should be ptr/int) ...do "->" op: put out d set of vars (set by XFST) STN:=ST_N2; STSC:=ST_SC2; LDL RR0,ST_VAL2 ...R0:=ST_VALH2; R1:=ST_VALL2 SVSTATE(ST_TYP2,ST_AGG2) RET DOUNOP1: ...common stuff for DONEG,DOCPL,DONOT; ret. R3=upconverted type OUTLOAD() ReST() SVOPTYP(ST_TYP) CVTUP(ST_TYP)(B.'p') RET SVSTOFF: ...save offset from ST_vars, incl. bitfld size,offset, str. size R0:=ST_TYP if RL0=BITFLD or R0=STRT then begin ...just chk lo-byte for bitfld if R0=STRT then begin SVHEXO(R3:=@ST_AGG[SDSZ]; R2:=0) end else begin L3:=INT; R5:=0 end else begin SVOPTYP(ST_TYP2) SVp_() SVp_() R3:=ST_TYP; R5:=ST_AGG end end else begin DECREF(ST_TYP2)->R3 GETSZ(R3,ST_AGG2)->R3 SVHEXO(R3; R2:=0) SVp_() SVOPTYP(ST_TYP) SVp_() R3:=ST_TYP2; R5: MAKSNUM()->R3->R10 ...STN OUTSTRG(R3,R8) ...put out label & string; rel. membuf with string ALCODE() ...make sure aligned OUTLAB() SUBL RR0,RR0; STSC:=STATIC; R10:->STN SVSTATE(ARY+CHAR,R9) restore R8..R10 R0==R0; RET GETW: RL3:=@(R7:-1); RH3:=@load of left side, save state=indirect acc ReST(); XFST() ...recall & transfer state to 2nd set of vars. OUTLOAD() ...put out load ReST() if ST_TYP=INT then OUTCVT(INT,PTR) else if ST_TYP&TMASK<>PTR then WRGTYP() STN:=0; STSC:=INDR; LDL RR0,ST_VAL2->R3 RET DONEG: ...negate item on STACK; update state PUSH R8 DOUNOP1()->R3->R8 if R3&TMASK not zero then WRGTYP() SVOPTYP(R8) SV1(B.'n') OUTuRe3() SVSTACC(R8,ST_AGG) POP R8; RET DOCPL: ...complement item on STACK; update state PUSH R8 DOUNOP1DL RR2,ST_VAL; RH3:=RH2; RL3:=RH0 ...RH3=bit offset, RL3=size SVHEXW(R3) end SVHEXO(LDL RR2,ST_VAL) SVReRe() end else SVHEXO(LDL RR2,ST_VAL) ...SVHEXW(ST_VALL) RET SV1: Outset(); RL3->@R7'; Sav(); RET Re3: Re(); Re(); Re(); RET SVReRe :=ST_AGG2 end RET DOINDR: ...enter with state on STACK; chg state to indirect of state & save ...put out load of pointer OUTLOAD() ReST() if ST_TYP&TMASK<>PTR then WRGTYP() STN:=0; STSC:=INDR DECREF(ST_TYP)->R3; SUBL RR0,RR0 SVSTATE(R3,ST_AGG) RE(R7:-1); RET ReST: ...recall state from STACK, save in ST_TYP,ST_AGG,ST_VALH,ST_VALL,ST_SC Outset(); Re() B.@(R7:-1)->ST_SC GETW()->R3; PUSH R3; GETW()->R2; POP R3; LDL ST_VAL,RR2 GETW()->ST_N GETW()->ST_AGG GETW()->ST_TYP OUTDUN(); RET CKADRCON:  SVSTATE(ST_TYP2,ST_AGG2) RET DOARY: ...enter: on STACK=state for array subscript; below that another state ...combine for array & save state OUTADDSB(B.'+') ReST() STN:=0; STSC:=INDR DECREF(ST_TYP)->R3; SUBL RR0,RR0 SVSTATE(R3,ST_AGG) RET CKSCA()->R3->R8 if ISINT() not then WRGTYP() SVOPTYP(R8) SV1(B.'~') OUTuRe3() SVSTACC(R8,ST_AGG) POP R8; RET DONOT: ...do NOT of item on STACK; update state OUTLOAD() SVCON(0) OUTRELOP(B.'=') RET ... DOUNOP1() ... SV2(^TWOs) ... SV1(B.'!') ... OUTuR= .SAV(Re Re) ; ...SVHEXW := .SAV(OuthexW) ; ...SVHEXL := .SAV(OuthexL) ; ...save RL2,R3 in hex: ...SVHEXO := .SAV(.DO(PUSH R3;RL3:=RL2) OuthexB .DO(POP R3) OuthexW) ; OUTLDRe3 := .OUT("L"Re3) ; OUTLDRe4 := .OUT("L"Re3 Re) ; OUTLOGOP: ...state on stack=T DOPTRTO: ...enter with state on STACK; chg state to ptr-to-state & save ReST() if RL0:=ST_SC<>EXTDEF and RL0<>AUTO and RL0<>INDR or ST_TYP&0FF=BITFLD then begin Errm(); DEFT "CAN'T POINT TO " end STN:=ST_N STSC:=ACC if RL0<>INDR then begin if C...chk if type R3=ary/ftn R3:&TMASK==ARY; RET Z; R3==FTN; RET SVSTSZ: ...save size/type char. for type ST_TYP if CKADRCON(ST_TYP) then RL3:='p' else if R0:=ST_TYP=STRT then RL3:='s' else if R0=FLOAT then RL3:='f' else if R0=DOUBLE then RL3:='d' elseLAR: ...chk if type R3=scalar R0:=R3 if R3:&TMASK zero then begin R0==STRT; COMFLG Z end else R3==PTR RET ...TWOs: DEFM '2s' P_: DEFM 'p_' F_: DEFM 'f_' D_: DEFM 'd_' SVOPTYP: ...save 2 chars. representing type R3 (p_/f_/d_/1u/2u/4u/2s/4s) PUSH Re3() ... SVSTACC(INT,ST_AGG) ... RET ISINT: ...chk if type R3=integral type R0:=R3 R3&TMASK; RET NZ R0==CHAR; RET Z if R0>=UINT then R0:-(UINT-INT) R0==INT; RET Z; R0==SHORT; RET Z; R0==LONGT; RET EQVTYP: ...chk if types R3 & R5 are both same modifilabel; jp so get value 1 if true, 0 if false OUTJPF() SVCON1() OUTLOAD(); FORCREG(); OUTRMV(); Ig() OUTJP() EXC(); OUTLAB() SVCON(0) OUTLOAD(); FORCREG() EXC(); OUTLAB() RET DECREF: ...remove 1st type modifier from type R3 (later handle aggptr?) KADRCON(ST_TYP) then begin STSC:=ST_SC; R3:=ST_TYP JR DOPTX end STSC:=PTREXT if RL0=AUTO then STSC:=PTRAUTO end INCREF(ST_TYP)->R3 DOPTX~ LDL RR0,ST_VAL ...R0:=0; R1:=ST_VALL SVSTATE(R3,ST_AGG) RET DOINC: ...increment item (should b if RL0=BITFLD then RL3:='b' ...just chk lo-byte of bitfld else begin if R0=UNIONT then WRGTYP() GETSZ(R0,0)+'0'->R3 ...ascii digit=size of int end SV1(RL3) RET OUTLOAD: ...put out load of item with state on STACK save R8,R9 ReST() if RL0:=/ 8; R8:=R3 if CKSCALAR(R3) not then WRGTYP() if R8&TMASK zero then begin if R8=FLOAT then R1:=^F_ else if R8=DOUBLE then R1:=^D_ else begin if R8>=USHORT or R8=CHAR then B.'u' else B.'s' B.()->SV2BF2 GETSZ(R8,0)+'0'->R3; RL3:->SV2Ber or both same unmodified ... basic type (unsigned equiv to signed) R0:=R3; R1:=R5 if R3:&TMASK zero then begin R5:&TMASK; RET NZ R0&BTMASK==R1&BTMASK; RET Z SAMSZINT(R0,R1); RET end R3==R5&TMASK; RET SAMSZINT: ...chk if types R3 & R5=same  R0:=R3&BTMASK; SRL R3,2; R3:&(-BTMASK-1)|R0; RET ...FCALL0 := .DO(ARGSPC:=0) .OUT("s") ; FCALL0: ...init ARGSPC=0, get snum for it->ARGSPCSN; send "s"+ARGSPCSN ARGSPC:=0; MAKSNUM()->ARGSPCSN->R3; OUTsHEXW(R3); RET FCALL2: ...send CALL with size of rete lval) on STACK DOINCD(B.'+'); RET DODEC: ...dec. item on STACK DOINCD(B.'-'); RET SVCON1: R3:=1 SVCON: R2:=0 SVCONL: SAVKL(); KTYP:=INT; SVSTCON(); RET DOINCD: ...enter with state (should be lval) on STACK; RL3='+'/'-'; do inc/dec PUSH R6; RL6:=RL3ST_SC=CONST then begin SVHEXL(LDL RR2,ST_VAL); SV1(B.'K'); SVSTSZ() OUTLDRe3() end else if RL0=STATIC then begin ...string (type should be array) SVHEXO(LDL RR2,ST_VAL); SVHEXW(ST_N); SV1(B.'g'); SV1(B.'p') OUTLDRe4() OUTZP(ST_N); RELAGG(SF1 R1:=^SV2BF1 end end else R1:=^P_ SV2(R1) POP R8; RET SVp_: R3:=^P_ ... SV2: ...save 2 ascii bytes @R3 Outset(); R1:=R3; B.@R1->@R7'; B.@R1[1]->@R7'; Sav() RET RESULTTYP: ...get type of result of binary operation involving types R3 & R5 size int (set Z) ...also ret. R3=1 if R3=lower int than R5, else 0 PUSHL RR8 R8:=R3; R9:=R5 if ISINT(R3) and ISINT(R9) then begin GETSZ(R9,0)->R9; GETSZ(R8,0)->R3 R3==R9; R3:=0; TCC ULT,R3 end else R3:=0 POPL RR8; RET OUTCVT: ...send conversio value & whether indirect or not, followed ... by am't to inc stack after (ARGSPC) + snum (ARGSPCSN) PUSH R8 ReST() if ST_TYP&TMASK<>FTN then WRGTYP() DECREF(ST_TYP)->R3->ST_TYP->R8 if R3:&TMASK not zero and R3<>PTR then WRGTYP() SVSTACC(R8,ST_AGG)  DUPLVAL() OUTLOAD() SVCON1() OUTADDSB(RL6) OUTSTORE() POP R6; RET DOPSTINC: ...enter with state on STACK; do post inc DOPOSTOP(B.'+'); RET DOPSTDEC: ...enter with state on STACK; do post dec DOPOSTOP(B.'-'); RET DOPOSTOP: ...enter with state ofT_AGG) end else if RL0=EXTDEF or RL0=PTREXT then begin OUTEXT1() OUTLDRe3() end else if RL0=AUTO or RL0=PTRAUTO then begin OUTAUTO1() OUTLDRe3() end else if RL0=REGISTER then begin SVSTOFF() SV1(B.'r') SVSTSZ() OUTLDRe3() end el...(not ptr) save R8,R9 R8:=R3; R9:=R5 CVTUP(R8)->R8; CVTUP(R9)->R9 if R8=DOUBLE or R9=DOUBLE then R1:=DOUBLE else begin R1:=INT if R8=ULONG or R9=ULONG then R1:=ULONG else if R8=LONGT or R9=LONGT then R1:=LONGT else if R8=UINT or R9=UINT n op to change type R3 to type R5 PUSH R8; R8:=R5 SVOPTYP(R3) SVOPTYP(R8) SV1(B.'V') OUTuRe3() ...OUTuVRe2() POP R8; RET ...OUTuVRe2 := .OUT("uV"Re Re) ; OUTDRe := .OUT("D"Re) ; OUTRMV := .OUT("R") ; OUTSTORE: ...store state on STACK (should be AC ...new state after call if R8=STRT then SVHEXO(R3:=@ST_AGG[SDSZ]; R2:=0) if ST_SC=EXTDEF then SVcHEXW(ST_N) else SV1(B.'i') if R8=STRT then SVReRe() SVSTSZ() OUTCRe2() SVHEXW(ARGSPCSN) R1:=ARGSPC while R1&(ALSTACK-1) not zero do R1:+1 SVHEXO(R3: lval on STACK, RL3='+'/'-'; do post inc/dec save R6 RL6:=RL3 B.DUPLVAL()->RH6 ...RH6=ST_SC OUTLOAD() if RH6<>INDR then begin ReST(); RESVST() ...get ST_TYP SVSTSZ(); OUTDRe() ...send "D"uplicate for size(ST_TYP) DUPST(); ReST(); EXC(); REse if RL0=INDR then begin if CKADRCON(ST_TYP) not then begin SVSTOFF() ...save offset incl. bitfld size,offset, str. size SV1(B.'i') SVSTSZ() ...save size/p/s/b OUTLDRe3() end end else if RL0=TLABEL or RL0=FLABEL then begin then R1:=UINT end R3:=R1 restore R8,R9 RET OUTADDSB: ...add/subtract (according to RL3='+'/'-') state on STACK to (from) ... state below on STACK (should be ACC sclass); update state save R6,R8,R9 RL6:=RL3 OUTLOAD() ReST(); XFST(); ReST() if ST_C) to state below on STACK ... (should be object); save state=top state with other state removed save R8,R9 ReST(); XFST(); ReST() R8:=ST_TYP; R9:=ST_TYP2 ...store from st2->st if CKADRCON(R8) then WRGTYP() if R8&0FF=BITFLD then R8:=UINT if EQVTYP(=R1; R2:=0) OUTrRe2() POP R8; RET SVcHEXW := .SAV("c"OuthexW) ; OUTsHEXW := .OUT("s"OuthexW) ; OUTCRe2 := .OUT("C"Re Re) ; OUTrRe2 := .OUT("r"Re Re) ; CKMOSU: ...chk if last id=mos/mou; ret. SYMPTR=^symtab entry if so Lkupnl_T(LASTDE; R7:); RET NZ RLSVST() end SVCON1() OUTADDSB(RL6) OUTSTORE() if RH6=INDR then begin SVCON1() if RL3:='-'=RL6 then RL3:='+' OUTADDSB(RL3) end else begin Ig(); OUTRMV() end restore R6 R0==R0; RET DUPLVAL: ...duplicate state (should be lval) on STACK; iRESVST() OUTLOGOP() ...get value 1 or 0 ReST() end ...save new state R8:=ST_TYP; R9:=ST_AGG if R8&0FF=BITFLD then R8:=UINT else if R0:=R8&TMASK=ARY then begin R8:&(-TMASK-1)|PTR; R9:=@ST_AGG[SDPTR] end else if R0=FTN then INCREF(R8)->R8 SVTYP&TMASK=PTR or ST_TYP2&TMASK=PTR then begin PTRADDSB(); R3:->R8; R5:->R9 SV1(RL6); OUTbRe5() end else begin SVOPTYP(ST_TYP2); SVOPTYP(ST_TYP) RESULTTYP(ST_TYP,ST_TYP2)->R3->R8; R9:=0 SVOPTYP(R3) SV1(RL6); OUTbRe4() end SVSTACC(R8,R9)R9,R8) not and SAMSZINT(R8,R9)=0 then begin ...chk if need conversion (SAMSZINT here chks R8<>lower int than R9) ... OUTDUP() OUTCVT(R9,R8) OUTSTOR2() ... OUTRMV() SVSTACC(R8,ST_AGG) end else begin ...OUTSTOR2() OUTSTOR2() RESVST2() 0:=@R13[SCLASS]&BSCMASK==MOS; RET Z RL0==MOU; RET XFST: R3:=^ST_TYP; R5:=^ST_TYP2; R1:=STLEN; LDIRB @R5,@R3,R1; RET CKLVAL: ...chk if type R3 & sclass RL5=lval (except register) if RL5=EXTDEF or RL5=AUTO or RL5=INDR then begin CKADRCON(R3); COMFLG Zf=INDR, send ... "D"uplicate accum.; ret. RL3=ST_SC DUPST() if ST_SC=INDR then begin SV1(B.(SZPOINT+'0')); OUTDRe() end RL3:=ST_SC RET DUPST: ...duplicate state on STACK; rets. ST_SC, etc set ReST() RESVST(); RESVST() RET ...OUTDUP: ...enter R3=sSTACC(R8,R9) restore R8,R9 R0==R0; RET OUTEXT1: ...save stuff for OUTLOAD or OUTSTORE of external if ST_TYP&TMASK=FTN then begin SVHEXW(ST_N) RL3:='c' end else begin SVSTOFF() SVHEXW(ST_N) SVReRe() RL3:='g' end SV1(RL3) if ST_SC=E restore R6,R8,R9 R0==R0; RET OUTuRe3 := .OUT("u"Re3) ; OUTbRe4 := .OUT("b"Re3 Re) ; OUTbRe5 := .OUT("b"Re3 Re Re) ; PTRADDSB: ...set up for ptr add/sub; enter with ST_TYP,ST_TYP2,ST_AGG,ST_AGG2 ...save size of object pointed to, type2, type1, result 0  ...save from state 2 end restore R8,R9 R0==R0; RET OUTSTOR2: ...have ST_SC,ST_TYP,etc; conversion done; send store if RL0:=ST_SC=EXTDEF then begin OUTEXT1() end else if RL0=AUTO then begin OUTAUTO1() end else if RL0=REGISTER then begin SVS]) R1:=R8; R8:=@R8[L_LINK] M_REL(R1) end else begin if R10=0 then R10:=R8 else R8:->@R9[L_LINK] R9:=R8 R8:=@R8[L_LINK] end end end RL6:->STSC; SUBL RR0,RR0 SVSTATE(0,R10) restore R6..R10 R0==R0; RET OUTJT := .OUT("JT"Re Re) ; OReST() if SAMSZINT(ST_TYP,INT) not then OUTCVT(ST_TYP,INT) SVSTACC(INT,0) FORCREG(); Ig(); OUTRMV() RET GETSWTAB: ...get buffer for switch table & init hdr to 0; ret. R3=^buffer M_REQE(SWTABSZ)->R1 RL0:=0; RH0:=SWHDRSZ; R5:=R1 repeat RL0:->@R5' unt R0==R0; RET OUTRELOP: ...do compare (according to RL3="=#<>[]") state 1 down on STACK ... (should be ACC sclass) to state on STACK; update state save R6 RL6:=RL3 OUTLOAD() ReST(); XFST(); ReST() SVOPTYP(ST_TYP2); SVOPTYP(ST_TYP) SVOPTYP(INT) SV1(ally don't care SVSTATE(0,0) RET OUTJPRe: ...put out jp, then zp, to label on STACK ReST() OUTJA(ST_N) OUTZP(ST_N) RET OUTDEFLAB: ...enter with state=jp to label; define that label & any labels ... which are to be same equal to label below on STACTOFF() SV1(B.'r') SVSTSZ() end else if RL0=INDR then begin SVSTOFF() ...save offset incl. bitfld size,offset, str. size SV1(B.'i') SVSTSZ() ...save size/p/s/b end else begin Errm(); DEFT 'NOT LVAL ' end OUTSTRe3() RET OUTSTRe3 := .OUTUTJF := .OUT("JF"Re Re) ; OUTJRe3 := .OUT("J"Re3) ; OUTJA := .OUT("JA"OuthexW) ; OUTlabCZ := .DO(PUSH R3) OUTlabC .DO(POP R3) OUTZP ; OUTlabC := .OUT("lC"OuthexW) ; OUTDFlabZ := .DO(PUSH R3;R3:=R5) .OUT("d"OuthexW .DO(R3:=@R15) OuthexW) .DO(POP R3) Oil RH0:-1; R3:=R1 RET LABCASE: ...enter with value on STACK; make & define tmp. label & save in SWTAB save R8,R9 R9:=SWTABP[SWLVL] while R1:=@R9[SW_PTR]<>0 do R9:=R1 if B.@R9[SW_CNT]>=(SWTABSZ-SWHDRSZ) then begin GETSWTAB()->R1->@R9[SW_PTR] R9RL6); OUTbRe4() SVSTACC(INT,0) restore R6 R0==R0; RET SVSZFACT: ...enter with state on STACK; take off & save size of ReST() GETSZ(ST_TYP,ST_AGG)->R3 SAVKW(R3) RET OUTLDRF: ...load reg. number in R3 with @(fp+R5) for type R1 ...called from CDECL K; then zap all PUSH R8 ReST(); XFST(); ReST() OUTDFlabZ(ST_N2,ST_N) R8:=ST_AGG2 while R8<>0 do begin OUTDFlabZ(@R8[L_N],ST_N) R1:=R8; R8:=@R8[L_LINK] M_REL(R1) end OUTZP(ST_N) POP R8; RET OUTGOTO: ...enter with SYMPTR=^label entry; put o("S"Re3) ; SVSTABTYP: ...save ABSTYP,ABSAGG SVSTATE(ABSTYP,ABSAGG) ...don't care about other fields RET DOTYPCAST: ...enter with state on STACK, below that state with type & aggptr ... to convert to; save new state OUTLOAD() ReST(); XFST(); ReST() UTZP ; OUTJP: ...make tmp. label; put out jp to & save on STACK MAKSNUM()->R3->STN OUTJA(R3) STSC:=0; SUBL RR0,RR0 ...actually don't care SVSTATE(0,0) RET OUTLAB: ...define label saved on STACK (remove from stack) ...also define symbols which are :=R1 end R8:=R9+SWHDRSZ+@R9[SW_CNT] ReV() ...->RR2 LDL @R8,RR2 MAKSNUM()->R3->@R8[4] OUTlabC(R3) @R9[SW_CNT]+6->@R9[SW_CNT] restore R8,R9 R0==R0; RET LABDEFLT: ...get & define tmp. label for default case of switch & save in SWTAB ...ret. Z=0 iff save R6,R8,R9 R8:=R3; R9:=R5 GETSZ(R1,0)+'0'->R6 SVHEXO(R3:=R9; R2:=0); SV1(B.'f') SV1(RL6) OUTLDRe3() SVHEXO(R3:=R8; R2:=0); SV1(B.'r') SV1(RL6) OUTSTRe3() OUTRMV() restore R6,R8,R9 R0==R0; RET SVARGSPC: ...save ARGSPC & ARGSPCSN on stack POut jp to it OUTJA(@SYMPTR[SNUM]); RET INCLUPLVL: if LUPLVL:+1>=MAXLUPLVL then TUDEEP() RET LUPENTRY: ...get BRKLAB,CONTLAB for next LUPLVL; inc NLUPS INCLUPLVL() NLUPS:+1 MAKSNUM()->BRKLAB[LUPLVL] MAKSNUM()->CONTLAB[LUPLVL] R0==R0; RET SWENTRY: . if EQVTYP(ST_TYP2,ST_TYP) not then OUTCVT(ST_TYP2,ST_TYP) SVSTACC(ST_TYP,ST_AGG) RET ENDEXPRA: OUTLOAD(); Ig(); OUTRMV(); RET ENDEXPR: ...do end of expr. stuff ENDEXPRA() RELABAGG() R0==R0; RET SAVPL: B.'+'; JR SAVBINOP SAVMN: B.'-'; JR SAVBINOP Sto be same PUSH R8 ReST() OUTlabCZ(ST_N) R8:=ST_AGG while R8<>0 do begin OUTlabCZ(@R8[L_N]) R1:=R8; R8:=@R8[L_LINK] M_REL(R1) end POP R8; RET ...Z=1 OUTEXPR: ...enter with state of expr on STACK; do OUTLOAD & convert expr up ...also say  already have default case PUSH R8 R8:=SWTABP[SWLVL] if B.@R8[DEFLTFLG]=0 then begin B.1->@R8[DEFLTFLG] MAKSNUM()->R3->@R8[DEFLT_N] OUTlabC(R3) end POP R8; RET OUTBRe := .OUT("B"Re) ; BEGFREG: ...send 'begin with force reg'; use size of staP R1; PUSH ARGSPC; PUSH ARGSPCSN; JP @R1 RESARGSPC: ...restore ARGSPC & ARGSPCSN from stack; preserve Z-flag POP R1; POP ARGSPCSN; POP ARGSPC; JP @R1 STFTNARG: ...send store of ftn arg (state on STACK) rel. to sp; remove state OUTLOAD(); CVTSTUP() ReS..get BRKLAB for next LUPLVL; CONTLAB same as last ...also inc SWLVL & get buffer for SWTAB (ptr to->SWTABP) INCLUPLVL() if SWLVL:+1>=MAXSWLVL then TUDEEP() MAKSNUM()->BRKLAB[LUPLVL] CONTLAB[LUPLVL-1]->CONTLAB[LUPLVL] GETSWTAB()->SWTABP[SWLVL] R0==RAVTMS: B.'*'; JR SAVBINOP SAVDIV: B.'/'; JR SAVBINOP SAVMOD: B.'%'; JR SAVBINOP SAVSHL: B.'{'; JR SAVBINOP SAVSHR: B.'}'; JR SAVBINOP SAVLT: B.'<'; JR SAVBINOP SAVGT: B.'>'; JR SAVBINOP SAVLE: B.'['; JR SAVBINOP SAVGE: B.']'; JR SAVBINOP SAVEQ: B.'='; JR Sto put in ret. reg. OUTLOAD(); CVTSTUP() FORCREG() RET FORCREG: ...send store to ret. register ReST() SVSTSZ() OUTFRe() RESVST() RET OUTFRe := .OUT("F"Re) ; LWRTYP: ...chk if type R3R3->ARGSPC ...align rel. to new fp (fp should be set so aligned for everything) R2:=0; LDL ST_VAL,RR2; SVSTOFF() SV1(B.'s') SVSTSZ() OUTSTRe3() GETSZ(ST_TYP,ST_AGG)+ARGSPC->ARGSPC OUTRMV() RET CVTST0; RET DEFBRK: ...define & zap break label; dec. LUPLVL OUTlabCZ(BRKLAB[LUPLVL]); LUPLVL:-1 R0==R0; RET DEFCONT: ...define & zap continue label; dec. NLUPS OUTlabCZ(CONTLAB[LUPLVL]); NLUPS:-1 R0==R0; RET OUTBRK: ...put out jp to break label if LUPLAVBINOP SAVNE: B.'#'; JR SAVBINOP SAVAND: B.'&'; JR SAVBINOP SAVXOR: B.'^'; JR SAVBINOP SAVOR: B.'|' SAVBINOP~ B.()->BINOP; RET BINOP1: ...enter binop type in BINOP; do OUTLOAD, save BINOP on STACK OUTLOAD() SV1(BINOP) RET Re1: Outset(); Re(); RL3:=@R0 es incompatible, error R0:=R3; R1:=R5 if R0=DOUBLE then begin if R1&TMASK<>zero then WRGTYP() RESFLG Z; RET end if R1=DOUBLE then begin R0&TMASK; RET Z; WRGTYP() end R1&TMASK==PTR; RET Z; R0&TMASK; RET NZ R1==LONGT; RET Z; R1==ULONG; RET OMV, pop state ...rel. SWTAB buffers; dec. SWLVL save R6..R9 SVSTACC(INT,0) ... BEGFREG() R8:=SWTABP[SWLVL]->R7 repeat R9:=R8+SWHDRSZ; RL6:=0 while RL6<@R8[SW_CNT] do begin OUTSWTST(LDL RR2,@R9; R5:=@R9[4]) R9:+6; RL6:+6 end until RUP: ...if state on STACK (ACC sclass) smaller than int/double, convert up save R8,R9 ReST() R8:=ST_TYP; R9:=0 if ISINT(R8) and GETSZ(R8,0)0 then begin OUTCVT(R8,R9) CVTUP(R8)->R8 end SVSTVL=0 then begin NOTLUP: Errm(); DEFT 'NOT IN LOOP' end OUTJA(BRKLAB[LUPLVL]) RET OUTCONT: ...put out jp to continue label if NLUPS=0 then NOTLUP() OUTJA(CONTLAB[LUPLVL]) RET FTNSTMTI: ...do init. for function stmts, get ret. label LUPLVL:=0; NLU7[-1]; OUTDUN(); RET OUTBINOP: ...enter with state on STACK, below that binary operator, below that ... another state (should be ACC sclass) ...put out operation & save state EXC(); Re1() case RL3: of '+' or '-': OUTADDSB() '*' or '/' or '%': OUPSQ2: ...enter with state on STACK (acc & converted up), below that another ... state, below that label ...if st_typ< other typ, do cvt, label; if=, just label; ...if >, do outjp, label, cvt, label ...ret. with state on STACK save R8..R10 ReST(); XFS8:=@R8[SW_PTR]=0; Ig(); ...OUTRMV() if B.@R7[DEFLTFLG]<>0 then begin OUTJA(@R7[DEFLT_N]) OUTZP(@R7[DEFLT_N]) end repeat R1:=R7; R7:=@R7[SW_PTR] M_REL(R1) until R7=0; SWLVL:-1 restore R6..R9 R0==R0; RET OUTSWTST: ...generate compare witACC(R8,ST_AGG) restore R8,R9 R0==R0; RET OUTJPT: ...make tmp. label; put out jp true to & save (in place of prev state) ...handle cases of jf & jt to here OUTJPTF(B.TLABEL); RET OUTJPF: ...put out jp false OUTJPTF(B.FLABEL); RET OUTJPTF: ...make orPS:=0; SWLVL:=0 MAKSNUM()->RETLAB RET FTNSTMTX: ...define & zap RETLAB; also zap STRRETLAB if type=STRT OUTlabCZ(RETLAB) if FTNTYP=STRT then OUTZP(STRRETLAB) R0==R0; RET SAVFTNTYP: ...enter with SYMPTR @ftn entry; save FTNTYP,FTNAGG ...if type=struTMLTD() '&' or '|' or '^' or '{' or '}': OUTBITOP() else OUTRELOP() end RET OUTMLTD: ...mult/div/mod (according to RL3='*'/'/'/'%') state on STACK to ... (into) state below on STACK (should be ACC sclass); update state save R6,R7 RL6:=RL3 OUTLT(); ReST() R8:=ST_TYP2; R9:=ST_TYP; R10:=ST_AGG2 if EQVTYP(R8,R9) not then begin if LWRTYP(R8,R9) then begin OUTCVT(R8,R9) R8:=R9; R10:=ST_AGG end else begin OUTJP(); EXC(); OUTLAB() OUTCVT(R9,R8) end end OUTLAB() SVSTACCh constant RR2, then jp true to label R5 ...(zap label); leave acc. same state as orig. save R8..R10 LDL RR8,RR2; R10:=R5 ... DUPST(); SV1(B.(SZINT+'0')); OUTDRe() ...send "D"uplicate BEGFREG() SVCONL(LDL RR2,RR8) OUTRELOP(B.':') SVHEXW(R10); SV1(B get tmp. label; put out jp true/jp false to (according to ... RL3=TLABEL or FLABEL) & save (in place of prev state on STACK) ...if opp. jpt/jpf to here, make its label after jp ...if same jpt/jpf to here, make those labels pt. to same as this one savect, reserve space in bss region & make label: save label ... in STRRETLAB R1:=SYMPTR @R1[AGGPTR]->FTNAGG DECREF(@R1[TYPE])->R3->FTNTYP if R3=STRT then begin SETSTRBUF(FTNAGG)->STRRETLAB end R0==R0; RET FIXRETEXP: ...convert ret. expr to form forOAD() ReST(); XFST(); ReST() if ST_TYP&TMASK=PTR or ST_TYP2&TMASK=PTR then WRGTYP() if RL6='%' then if ISINT(ST_TYP) not or ISINT(ST_TYP2) not then WRGTYP() SVOPTYP(ST_TYP2); SVOPTYP(ST_TYP) RESULTTYP(ST_TYP,ST_TYP2)->R3->R7 SVOPTYP(R3) SV1(RL6);(R8,R10) restore R8..R10 R0==R0; RET SVLABL: ...enter with state on STACK, below that jpt/jpf ...if state=label, save label info in buffer, else OUTLOAD ...save state=label of jpt/jpf, st_agg=^to entry holding prev. label save R8..R10 ReST() if ST_.(SZINT+'0')) SV1(B.'=') OUTJRe3(); OUTZP(R10) ... Ig() restore R8..R10 R0==R0; RET ...OUTSWTST: ...generate compare with constant RR2, then jp true to label R5 ... ...(zap label); leave acc. same state as orig. ... save R8..R10 ... LDL RR8,RR2; R10:= R6..R10 RL6:=RL3; RL7:=TLABEL if RL6=RL7 then RL7:=FLABEL ...RL6=TLABEL/FLABEL, RL7=opp. ReST() if RL0:=ST_SC=RL6 then R3:=ST_N else begin if RL0<>RL7 then begin RESVST(); OUTLOAD(); ReST() end MAKSNUM()->R3 end R3:->STN; SVHEXW(R3) if CKSC return OUTLOAD(); CVTSTUP() ReST() if EQVTYP(ST_TYP,FTNTYP) not then OUTCVT(ST_TYP,FTNTYP) SVSTACC(FTNTYP,FTNAGG) if FTNTYP=STRT then begin ...if struct, store into ret. buffer SVHEXO(R3:=@FTNAGG[SDSZ]; R2:=0) SVHEXO(SUBL RR2,RR2); SVReRe()  OUTbRe4() SVSTACC(R7,0) restore R6,R7 R0==R0; RET OUTBITOP: ...and/or/xor/<> (according to RL3='&'/'|'/'^'/'{'/'}') state on ... STACK with state below on STACK (left op, should be ACC sclass) ...update state save R6,R7 RL6:=RL3 OUTLOAD() ReSSC=TLABEL or ST_SC=FLABEL then begin M_REQE(LABENTL)->R8 ST_N->@R8[L_N]; ST_SC->@R8[L_SC]; ST_AGG->@R8[L_LINK] end else begin RESVST() OUTLOAD(); ...Ig() ReST() R8:=0 end R10:=ST_TYP ReST() if R1:=ST_AGG<>0 then begin repeat R9:=RR5 ... DUPST(); SV1(B.(SZINT+'0')); OUTDRe() ...send "D"uplicate ... SVCONL(LDL RR2,RR8) ... OUTRELOP(B.'=') ... SVHEXW(R10); SV1(B.(SZINT+'0')) ... OUTJT(); OUTZP(R10) ... Ig() ... restore R8..R10 ... R0==R0; RET ...********* SVSTIDAB: ...enter with R1ALAR(ST_TYP) not then WRGTYP() SVSTSZ() if RL6=TLABEL then OUTJT() else OUTJF() R10:=0 if RL0:=ST_SC=RL6 or RL0=RL7 then begin if RL0=RL7 then OUTlabCZ(ST_N) R8:=ST_AGG while R8<>0 do begin if B.@R8[L_SC]=RL7 then begin OUTlabCZ(@R8[L_N SVHEXW(STRRETLAB); SVReRe() SV1(B.'g'); SV1(B.'s') OUTSTRe3() end FORCREG(); Ig(); OUTRMV() RET OUTRET: ...put out jp to ret. label OUTJA(RETLAB); RET OUTLDSW: ...enter with state on STACK; convert to int, send force reg. & remove OUTLOAD() T(); XFST(); ReST() if ISINT(ST_TYP) not or ISINT(ST_TYP2) not then WRGTYP() SVOPTYP(ST_TYP2); SVOPTYP(ST_TYP) R5:=ST_TYP2 if RL6='{' or RL6='}' then R5:=INT RESULTTYP(ST_TYP,R5)->R3->R7 SVOPTYP(R3) SV1(RL6); OUTbRe4() SVSTACC(R7,0) restore R6,R7 1 until R1:=@R1[L_LINK]=0; R8:->@R9[L_LINK] R8:=ST_AGG end STSC:=ST_SC; STN:=ST_N; SUBL RR0,RR0 SVSTATE(R10,R8) restore R8..R10 R0==R0; RET LABELSV: ...define tmp. label & save it MAKSNUM()->R3->STN OUTlabC(R3) STSC:=0; SUBL RR0,RR0 ...actu1 3=symptr of iddefab; save state with symptr in place ... of snum, value from hival; also mark ref'd MRKREF() STSC:=EXTDEF; R13:->STN; LDL RR0,R13[HIVAL] SVSTATE(@R13[TYPE],@R13[AGGPTR]) RET ADDOFF: ...enter with constant on stack, below that state .OO LONGaC.{p 0 AA0 8 AA063b$&+00 99.xp#_ 8(00 99.xp..xp u pL BL BL Bo! .xp2ҽ0! (s1 gݜġs wݓsg4ߋge^T $߫T] M_8FWD REF WITH DISP1L_ ,g5e" AA'7:56Hc4a<Tr*bYd p4!Vp6eVfCcpVc g6SuVeQ!Wg/W5S335SVpTtBw0&7ETdB0&$BcBVH_8MEMORY POOL USED UP`8  a3_..mult const*sizeof(decref(st_typ))+st_val->st_val; save new state save R8..R11 ReV(); LDL RR10,RR2 ReST() if R0:=ST_TYP&TMASK<>PTR and R0<>ARY then WRGTYP() R9:=ST_AGG if R0=ARY then R9:=@R9[SDPTR] DECREF(ST_TYP)->R3->R8 GETSZ(R3,R9)->R3; R2:=0 MYXL B f;_;Ӂ u !_2(an ]Tc _8 NOT DEFINEDL 8 AAQP7 x   ,,p Ηa :i :!1שs7/7qo 808a>s! ! !A!@QPU@@B(TҔ$]ҐS V]Ҟ([5ԫ&gd9Ga ֫` ll"A̋<==SK@,napp.{pšCІoon n o ЛoCo 8_8TOO MANY SYMBOLSa>1_ _ _̠ %P_.Q_&B a_1 q__ؕREF_(B]16( 0 2(Bu16( 24(BՊ4v 41a11pC_J_JMa"00o"a-_  ERROR _ Pa- B 901pL!h:a*_ L!o .[V !s09p?.xp:V_ LНL<a! t!La߷RVT ]T ]T$ ] T$]MM"]@]Hҩ]@,]<ұ]<Ҷ]H0]Da@3'ayT RxM _8TOO MANY REGIONS ]xisT<]rСT@]raH3ayT$Rx M,]x$isTP&TMASK zero then WRGTYP() GETSZA(ST_TYP,ST_AGG)->R5 SVADRVAL(LDL RR2,ST_VAL; R5:; R1:=ST_N) RET GETSZA: ...get size of type R3, aggptr R5, where array 'decref'ed ...if ftn, ret 0 save R8,R9 R8:=R3; R9:=R5; R1:=0 if R3:&TMASK<>FTN then begin if !11a>!B/11.80a>7/7!@a>=;$` g g `ݭ-㡷/na>1a!1o`  C na>3=3a,I G.M0M2'2 042"%US3 6"3ZS:H !r&Ht bHгփ7yБД12&HЁ bHs9з1U^Kn! }2?}:]      ;;ʽ x   ;;!  ! }2?}:]!_ /DO !oL<݅L=_JJL=M8M8 \4! ]4T4$"]4   騐  D]r]$TH]r LNdN]tfNߌd__fN_Ԟ!/PQMTt]fNeaT R]aT$R]$MLKٗ9TܜaL1o1TĬoR3=ARY then begin DECREF(R8)->R8; R9:=@R9[SDPTR] end GETSZ(R8,R9)->R1 end R3:=R1 restore R8,R9 RET SAVVALA: ...enter with R13=symptr; save (object size,symptr"a"val) ...also mark ref'd MRKREF() GETSZA(@R13[TYPE],@R13[AGGPTR])->R5 GETVAL() ...-"cK2K0K&1a o <`E3o >a >aE g a K a>Bo @a @C ` Ӂg= o @`8  MLAAa > B Љw` M _2 ^10*H10q D o ``0 aa1 TT5 nn2 oo3 ]]74&H .1o1s&1b]Y 0!    #!4e2u!!B .xp!s 8C0 ??  % ??   ~;^Zݞf;E!ss1aa0oas1p s!of;!CMaL3o0PT]xiLaL"]\4%M8_8NO MEM. FOR RELOC. TABLE _8!LOST RELOC. INFO WHEN TMP. EXITEDS8Շk8%`  aaJ_$`  *0Aoa8oW89T0ܜ T2ĔV]>RR2 (preserves other regs) SVADRVAL(R5:; R1:=R13) RET CKDEFAB: ...chk if id=def'd ext or static obj (except ftn.) if LKID() zero then begin if RL0:=@R13[SCLASS]=EXTDEF or RL0=STATIC then begin if @R13[TYPE]&TMASK<>FTN then begin SVSTID1 ߆a cL Ҹ Rem Space=a@Is!Е a1o  E x 80p q 1 10p x 8 MACAu?UndstaRg?EXTLa?UL?MOS???SNmMOUUNmTypMOE??? ^fa ChShI LgFlDbStUn BFUSUIUL@!a(Jn !a!ф !!ѐÃH" !!!ѦΕ씄ѭ!іWIg458T*u\_!oa`ߕLL;_WRITE`Ld;n!/`"`<c!!!Bء7 ^cD$!u`<j<_OPENo!1. {p {9T0$ T2 V]!A7ooi2K)K!a!A_T4a_ 8L`  g a0  nT"a_]P!U`  複.xp!P_7g_ `AB(); RET end end end RESFLG Z; RET CKDEFARY: ...chk if id=def'd ext or static array ...if so, save (object size,symptr"a"value) if LKID() zero then begin if RL0:=@R13[SCLASS]=EXTDEF or RL0=STATIC then begin if R0:=@R13[TYPE]&TMASK=ARa`a!0! ! d9P.  sc BҶXSҗ`    ``EŤU.tp.|p.up! d `.{pap 1p!s7TRXT 顃H `$֔k R#!!!k<ޡL$KK !2s>!2sT$2D` $n $T$]$ڠ2L$++cW4 j0u5  ;,<>=*" !! ~~ !TEU 8  0P` < ^h<!ЁpT /g7bЊ]Lߊ!^`:!_ ERROR TOTAL=_ P=!< XҤ*PL Y !Ё!g5d]߸_  ec*#0!V7__֕V_ _ CODE:_2_ _ DATA:_2ٗ_ TĔ_ T_  AT _ T_2K_ T_ T$_2K_ LENGTH=_ T ]Y then begin SVSTIDAB(); RET end end end RESFLG Z; RET CKEXTNF: ...chk if last id=extern/ftn; if so, save (objsz,symptr"a"value) LKID(); RET NZ if @R13[TYPE]&TMASK=FTN or B.@R13[SCLASS]=EXTERN then SAVVALA() ...else Z=0 RET CKFTNARY: Mp]ob OVER NESTED!^ q1a1p.xpo1poCa0 9,/T^ ף WRONG TYPE p {p sp zp rp } aa p yp qp xp po D.}p.rp.zp.sp.{pӂN&hӇY+p0S¡Ё֡T$` $n $!2~k!2ڃ2L$++ܖ܊!2su!2sښ!!!!W зsŕ  m ǡ ǔԠkנos^!_9HxL<La^[L<%! q^ q^uss0!1Q0TҖ] `L`ѮL:!џoo !  ɞ _READ!71!11:!!xbcnY bMa!"/!/528a ̽  a gK"9Kʃ/31!o/o"73ooЕ[a֩7 ߼a ֡C llng5cn&T  ...chk if last id=ftn./extern array ...if so, save (objsz,symptr"a"value) LKID(); RET NZ if R0:=@R13[TYPE]&TMASK=FTN or R0=ARY and B.@R13[SCLASS]=EXTERN then SAVVALA() ...else Z=0 RET FIXCONXI: ...if conexpr=addr ref (+offset) make rel. to 1st symӌqӐuSa.{p%p {n CI` C߂a Dn֡*o HWޡ(a Do F` C ??d$ma Ha FM ff ff aa aaІ KKԼ( KK”*` C#. aana H( aaa F*` C߾ aa3 0!ߔ à Ò벱"ý벱 (Ã벱. 59!:<9á Ô 벱SKvXQa ` Tg3 ! !  ! *WM8 M8RELOC. TABLE FULLT4A 8ߙߝqߡi8XKa }T!@} N(fYT!@}:N0fE]da!YfbTPP!1pa }R_}Z (}R_}Z nũђ" AA DDЩѽ EE 0ݩR \o ! K c` llA 5g@ŒBA52c7cg> AA;A̡;g35gaA5 JJ'1ǀ CC1mbol encountered ... and save snum instead of ^symtab save R8..R10 PpV() ...RR2=offset, RL5=tag, R1=poss. symptr, PTRSZ=poss. object size if RL5='a' then begin SUBL RR2,HIVAL[R1]; LDL RR8,RR2 R10:=@R1[SNUM] Ig() SVADRVAL(LDL RR2,RR8; R5:=P@a Fߋa H aaa FKna aaЏЮ !!$1"K nn fff0  ~~0  ++B6 --B1 **@, //' %%@ &&SB ^^SB ||SB {{' }}R'D !5 !0 13 ! !. / !7 !2 3YњѲѴ|!4\5q*` $ ` $γ94q?6` $9eR.(}R_}Z!! }R_}Z/!}R_}Z!`_}Z!PM HIJKL!1 y0^8rpo^816~o0038'008b- 901p00-aa11p x    p x   T DD g1Ǡ1 n! T K ^:` ll A gSpx;A ̔ހ7¡1? EE  Tg AwߡߚB5uJAq w=s1T]TRSZ; R1:=R10) end restore R8..R10 R0==R0; RET /ZAPALL TMPS /PACKALL  same level) DEFLT_N: EQU 4 ...label no. of default . object size if RL5='a' then begin SUBL RR2,HIVAL[R1]; LDL RR8,RR2 R10:=@R1[SNUM] Ig() SVADRVAL(LDL RR2,RR8; R5:=P/ % %@ ==B' ##B <<B >>B [[B ]]B ++դf, --ըf& **լf //հf == ## << >> [[ ]]ėD_KѦ!! PP2 м!4^М5qj!ў o n ]С5qЋЯ6` $-9eО¡5qЬf 22 ssR9S³chV`cq W  ;ވ@n 2M1 ?ݺn_&~M1 _8 COMPILER ERR _>.k17 ~ps[qsVa2"ޝo2"a2$ޢo2$a2"a2$_>` 2" nn_*6 ~~_*a1n62V dd dd_) dd 44!4s_)Ҡm_@ dd!4_@$).38<!Rs ?!ssG4 00 99  AA FFC?(X ppSC _ P  CALL P_ __ _ 1 ! ta}} C0h$ h㠉q&n `_`(``c Х1  LL` KK` 11 442_ &C VV 0 nn 11 44 ss*ܡ1  LL` gg ff rr ` 11 44 bbC8])0)%19_ _ _ڡ4! 80.xpC_6_ _  q..ECaa_ Ԟ_,_ ԗ_,_ ؗ _,_ Ηa x  $aL a*aoS_ aL  U_ _ P11 r ss ssñÂҋ 44k҅ ss ss! Ãҡқ dd Ҭ! 22ÍܠүÒkÒ벱kܫÔk͗ dd ʲÍ 22Í먿Å 11Ä 22!m_@L$KKL$8 n$ҡ©ݽݸL$KKO_ & Da10`>2_ ]$ ++ --"L2"ppa2&L2$ppa2$_%lhL2$pp L2&ppa2"_%Ya2"Go2"a2$Lo2$a2&Qo2&k߆%a2"롅a2$О {{ }}!2sLb03}} TM_aM 1 &߹!߾s_/qs1o6З2.8!__ !MF5!0 &354 5a0B!_!MLh 7 J83359ֽ!ML bb` ++ ** && || ^^ aaoo8Ў*$069 bb` ddk.` pp7_ w_ z0Q> 8 bb kk`;tC9m8 0v9 JJ` TT FF ` FFL_,a*K"&! Q Pu u p @@ u[[p | __ P0K"].xpp_ ؞______ 71(1.}2?}:5|a"oL߁La a_dL_Ca!JdT 5/] ==* ##% << ss >> ss  [[ ss ]] ss ۠5&ý6 ý{>2.79SïI%  W/}`*L$ؠyi )1u$a2&ЯT$V]$Ԡ&"a2$a2&ӡ8롅a2$ǠL$a2&РT$V]$ԡ`2"L$$` 2"_@a1n[2 dd dd 4u 4u 44 44 2u 2u!2sS+-*/%&|^{}!@T  !0 _ ͓52_ *ђ5_ <=>?z|} {{ { { 96.,(*   &$":;0123457pqrstuwTM_ a ֞X   d `!U!4VP {n:n ==# ##= <<] >>[ [[><0p0д0Ї0K8 80 IIߙc UU^^ LLY llKT dd O ZZJ SS[E FFt@ BB]; CCޕ6 JJ1 ssެ, rrޔ' EEW" XXR DD}2?oaKa7]oaoK }2?}:5ya]K@3}2?}:1^!!!_$/ߣ/x _V._\_\Ȟ_(a !tpo x AA* 22 !4nwӈ !ӍӑݼL$WM uuZ1L$u_}6 2s!4s!2sO!4ݱӺL$ àá 2u !4sqΠ!4sˠmqѕ]$L$KK߆4 22 00 pp ss4 bb2 pp!4u ffd(_A.p5i1M1_a1n>2̠렸M1a10`;2  M1 a1`92    aߒ!U*!4P?? ^ g!U>4 99. P!UF4 ' PP??!UK49S!UQ4GSP!U]!4VP PaM3VaMgMaMw RRq ..ߩ uug bb  kk,8 pp_ :_ 7_  Au_%    _ :63_ :7 _ :7_ JbT _!,_r_ __8M1 F GACCLVL FIXED\nM1 >0_ : ZZ __p { 00 99 p 00  { AA FF p 77 x    p //`x **p x  bp ** { //p  a\3u \\ a\ `{ pЅŞoO (XJЃ˞a 8_a 8_ k ddHL$၁L$▖ ddIL$ჃL$⒒ ddL,L$ዋL$␐L$KK 22T$ w 79éL$ჃëM[`$ 22`$L$KK ?aT$ 22iikL$ᅅL$ᇇL1 `2   `2d2_&JK1 `2n2_&JK1 `2  Ca1 f24a1`;2 a1n[2_&Va10`62 m  ` Ӡ_&~k1_1_Xjر Y W `MaM0Q ߥߩߙXٲaMgMTM1_gM 1_ٲAMQE1gM1_15S_ 7 BBezT$_5t7rgts_ CCT ] lu_ DDeyexerT _7rcs8_ :_ 93_ :_ 8aEog l_eeC̽ g5_c57c5_ :_ 1ga 85_З_ ,T T _T$_]Tw_ _ z_ p_ Q$቉T$Љ`$L$KK?ԋ 22ԑ 22{ `$L$KK? ԡԣL$KKuT$`ߠԩ9Ԯ! 44ŕL$KKuT$ڍҀ2à27y8 ddJL$KKT$є֡ 22!42 -i1a1`20`;2n20n828 n 2 n2 gg cc_ :o2L2KK_ & "L2cc_ ]2L2ss_ ]2L2bb_ :n2 n 2! 80n2" ;n 2# 80n2$ ;n 2% 80n2& ;n 2'` $n $T$]$ڗ`$ **_.6 _}}}$}55(}X gM_nX3aMTM]M&!0bq_oM~ ]MzoM^Z$aMTMb!_TMz aM~MM|TM &s!u X ОX??  OTMgMee >0 AA 60_ :7 AA TT FFc_6Nm9ݏ^ FF= TT#sq_&ơ_ 5J__ :6ۨCeŽ4_r 80n2 80n2 cc_ :o27s_ (us_ :_ 7u_ e}L2cc _&a2_ 5C_Uَ_ȞDa?FRgއRw/gFC mPCsN4hvMa.HߎY0GߒLMJߤ߅Ӄ]MLMBߤמBߴߕӓ߃?ӖX߲XߣӡL&߫TM03ӿ,ӱMMd gӹmÙ ms!@1L$ ddKL$L$KKT$ч֡ 2s!4sqҺ!4m8Û3L$ -á?L 2u!4sq8k!4sq>!4sm 4s@]) 4u&BeL$!"! lOr!sL$ //_/ 0 %%_/* ++_-# --_- ||_- &&_- ^^_- {{_.< }}_.z` $n $T$]$ڠ_-8L$::m` $Ҡ_+BdިDO ުޞHN_2܆޵IMAGE __#ޱ#_ORIGIN bswE _TM1357}6377 1 j! M 1^?# p !.}2?}:TMPMz^XjaMx00 b2 8*0 8!^Z2!1b_bx _G^ .xp.xp@_ _ ҶaM\ M^Za1`;2_>._(_&_&` 2ܟ g_ :_ 5E_C8_ *_ :9_ :_ 8_"(*g5_#e7ceT _$^_"_ra1`>2Qqܽ_&~Z7s`2`2 iin aM.[iMaMn ݼN߶ 5S߽ 5 pw,  qp ypC_}_3TM]_ڞ x   ,,TM q,,p"(nM!M݋7R5 /]M?TM1 @ՀՄ!@ՅL$߶    ߠL$v k߯ kk`$$n$ߨ` c``$&0fMN֠;.k%_CODE=޳_*AT޸_: DATA= _D_TEND SECTION_REGIONS_ EOF_START A __>BRKS-> %C_x+P_ 2PACKߑ_ ;CLEAR_JJCMAP x AApy_G^TM_ ԟc_ ~jM^Z!`M ^Y֪TMҹTM]aMoTM]\ M^K73}B?1:# p !.O}JaT^Zo}2oaM?K aM  @?!@SS a}:a^J_JL_J~a @_d$ pp ssڠ{頾{ T2 KK_&0 rr_'n* ff pp ss_(\_(p ii pp ss_(_( pp ss_'_' bba2_ 5DT2_` 2 !2u_)L2!` 2!5_)130g`2`2]M_ ߝ!P!a_]M 80_ P 80_ P_ |.xp 8   ..xp0 |.xp_ >&!_ h;a  _ _ y䡍 Eqqn_ 9` %sk LL  8_>_@_BD_A._>.14nߨ_RLIST UXOFFb;_ON߉_gEND ߑ_2f__ xWRITE ߈}߀,ߎtޞ߉DIAGd;_z^Zߘ/_\__|(_  ߧߪUNDEF ߱UNREFߦߩ ߾R=ߣ_o0N_GN q _V! }2oLE`_TLM q// p_D$0֫+8LM!Z_GN q _J~a"o_DSG!ZF_K$Z!Z}: - uHHp00 99.xp(00 99.xp..xp+ iiܞ܀Чn $ܷ{݊}_@T2 rr_) [ ff ss bb xT2_(\ ss߶ߟ_)2B ii ss bb ݑT2_( ss߸_)L) ss ssݧT2_(_)t ss bbݸT2_'_)О ss bba1`62a11p+.xp_ PTM_ &_ ߚө _ ߥީ _ R0 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10R11R12R13R14R15 N4 FC_ DM!BUM!S#/CCBQB  @1p=.xp_    _ ..xp8M1.M12a10K12a12o1. M1.a10 M12o121 1!14o10a12o1.)a123 II UU XX .. JJ RR EE1a12o12a1.0 1߫_o2a0o2d;LME=_F=S_.)_Ҟ^ J^ ^ ^ ^ ^ ^ ^^Tg_ڞlߣpg^J&ki/$Lb47+:-381>ݔ2<_,_,= u po! .xp(PONеH!100 80<fP4^;ԧ u ! 80 ==a xpaPۂ_gbrqTP" '' 8̩0oP$0 80oP$!1L\L\L\%L\" x ##0`>2֠_&~{mT2_%yza1`62n$a10`;22_@L2!72_&~` 2!н5_)` 2 !2uQ_)2_(ӡ5` 2 @ 2!ڗ5` 2 5{_)}2Ƞ_)LΕ 8a1`>2  x a1n[2_&~_  TM!Oߗߥ_     _ ߶_ps   *  ڄ߽.H AATMs_̆x_ؗ s xp_!14K100 [ S67Wpgs" .89*80.9 1 1 89JM6nogr_ z0A65(ߩ`ci: uu ```߶(`kc!6LЃ: bbB_T_,_,_ G q pa"o*_f;I q p" oK_iy.ߎ~..ߔ { DDp x      pCL_M0M2M,M. !o,=o.! _ړ_ڠ/P_TW_3 L\ ## pL\݀ݼL\_KL\_H_2_Ga\UP`[\ CM\[L\L\h\L\ _8MACROS OVERNESTEDb\a\o\f\L\![o\`\L\L\ x  ,"_K xp "" 9`{ \\d\ ''Me _8TOO MANY INIT'Saeځ3a8faeځ3a9eMeaeګ03a1efaeځ3a1f&!aeځ3o8faaeځ3o9eꡃ 38ޙ޳;-߯M0 0 ieaaeځ3o9e0aeځUoSeSaeځUoSf8څ3  ь ieڽ0aeO a|o}L} a|x` |n }a| L} L}a|שT|a|1+-1 _H.M|t+-ޠӅ  Ӵ5_t+0 2-+%_ = ?6789aeUoSe0aeUoSeae3a3e9aeUoSeMeMeċ!ڞ! ޞ96_r8/d_5!0ae3a3eaeUaUeP8Ya e½ 0 0 a egM|M|M|M|o_KH (_KM|M|_H._L  (M1 // { **pd\f\s0a\0o\a_ _ &_ CaL\ !\a\AqIPWpo\f\a\o\Ho\L\a\a\1AS \ݵAPo\` { (("fog\p x ,, )) _8MACRO RUoSeaeځ3o9f:aeځ3o9f&^qLfOMekeaeګ03a3e!1 aeځ3K1ekeڡ%aeځ3a3f1  ;߫T  ~\]8*DP 9I_ڡ KK  _|! ff  _|0 _|_M2|n }T|a|a|Ԕa|o}` }n }T}a|a|Ԥ"a|a|_it 80_|n>a|Ɨ8_|~/Pa|ؗ0О=i00     0Q00S0S8Y0aЩ ˡ0/ӡao eo 0 _ A e o e  4  > 7]eaeoeaeoeae`;en eae  ae, oe߾ߪߒ|M|M|_H._K (M|M|M|_H._ KK_|_o|a|os_ _|f_M|_K { ..p { EE p { ++ --pL}M}_G^_ơS_a}_EF >1 LINE`c3o7\p ))o\ x  Ep "" ''ɞ (( { ))p // { **pƞ x  "" {  { ""p { ''p x  Ep \\ { E_K_K_Kp x ** `{ //  E_M4 Ve]eҕ_GRIp_,_,_Gb6WLfN4yߓMfP0_ KK_|` fN3EfPofP` fNn fN  afPRnLfNMfP2߻8ߧaeځUaUeҎ8_ KK$ _8 UNION INIT<>0Qߖaeځ3A0f&aeځ3a1f: aNCGHASH: EQU 16 ...no. of chains in CGTAB ...CGTABSZ: EQU 01600 ...size of CGTAB ...AREFTABSZ: EQU 0600 ...size of AREFTAB ...RELOCTBSZ: EQU 0C00 ...offsets for entries in code generator's symbol table: ADRHI: EQU 0 ADRLO: EQU 2 LNK: EQU 4 CGFLG: EQU 6F_8!INCOMPATIBLE SYMBOL REDECLARATIONRe e c LeLee ` en aeoaeo` en Te7`e       _Ip_I\`  Le LeaeNj`  `e   Ɣ_` }.{p_Gf_I>a 8c5 8`    L}ao}  _|n}M}5aaG_ڔ L}M}a|PU1 ع_t_ڡ8_hl9_ z:l(ؽL}o }!2|p {p s_G^_,ppq:a \!\ 9 3 00/ 99, 00K\ _8UNMATCHED MACRO ARGS 3a4\@3a5\L\a\T K@ޚ!\ޠo \20s``??`n`aoaeځ3o0f:aeځ3o0f&aeځUASeaeځUoSe5Te֔]e֒$E5TeReҡ8桃  ҿŞ!$_ڽQ6``0Q(Z_ Ve]eҔ_GRI_Gb 00.}p 11_ p 22_  44 SN: EQU 8 CGENTSZ: EQU 10 ...size of entry ...bits of CGFLG: CGZAPB: EQU 6 ...1=symbol zapped CANZAPB: EQU 5 CHAINB: EQU 4 CGUNDEFB: EQU 3 UNFIXB: EQU 2 ...1=symbol value not fixed DEFNB: EQU 1 ...symbol defined with "define" CDSYMB: EQU 8 ...1=symbo   5Pe LeLeaaKeȞ6f f`caf_6ffac_6` eJ Ce Ќe _G^`91p_Gf_I>` c aaeUoSeaaeUoSe_]e` e neM {n |2]|o|o|o|_ 0 0  a| p!a| s f d  b _|P_ol02N`|  T|_M(K@7+I T|_M2a|_MgPpR5a|a|_k(1  ߯L(  ߚU`oTc     E_QP NOT DEFINEDLP 8 AAa!PJoMU QP7 x   ,,M_GJdefine U_K_Gjߖz]9._GJundefg_K_Gjޣ_GJincludeu_GJ<__ z_ڡ89aeځ3a3f "҅ _H( *aeځ3a3f _| _H(4Ҕ_6 _6_|_ z18"Q_K0afR F _8TOO MANY STRINGS 3o5fT3o0fifR_GRlD_ _Gb_GRZ_ _GbX l def'd in code region DTASYMB: EQU 9 ...data region BSSSYMB: EQU 10 ...bss region ... REGNMASK: EQU 0700 ...covers CDSYMB,DTASYMB,BSSSYMB ...machine dep. equates: SZBASJP: EQU 2 ...size of basic JP inst without addr SZBASCALL: EQU 2 ...ditto CALL SZeMea_ Ԟc `  a 852_H.a_ Ȟ` ae3a1e      c aaeUoSeae3a1eoe   ` e neMeʒ"]epe ae3a1eodaeUoSe!_r6c5occ.8 ߔrsj^  a|zߡi߀wk  ܣdХa|a |  0 0 a|a9 ǡ8Ta|0  a|_Mca|_M߸gL|pОfL|pܞa|    a|!3 GJ"_Gj_F_GjR߇_GJifdefߎ_K_Gjޮ_GJifndefߜ_K_Gj޵_GJif҃_Gj޹_GJendifދ_Gj_GJelseޡ_Gj_fa_ _ a_6c !a_ LaMa~`~o a_GJ(_Gj_GJ,_Gj_GJ)_Gj_3 Qбs_6KfR3a9fࡓUaUfT#-MglMgl _8TOO MANY PARAMSMeMeLe"]eLeLeagl3o=gnigl_IH` _ ,aeoaeo` en !g.!g.0_DECSP: EQU 4 ...max. size for "dec sp" (in this case SUB) SZENTR: EQU 12 ...max. size for "enter func" sequence SP: EQU 0E ...here for now FP: EQU 0C ...host machine dep: AREFENTSZ: EQU 4 ...for addr with AREFCD bet. seg. & offset AREFCD: EQU 1 ...el0ieMe _ae3a8eae3a1ed   ` e aen8eae03a8e`Me€ ߱! _80 SIZE IN STRUCT 0Mekeae3a1ebԽ ae`;e  ae  _|_ڠ oe#__M2T|# _MT|_M2T|_M2_G^.{p_Gf_,_,_,_G^_,_,_Gf_GRL_Gb_GRL_,_Gbڿݏܚ_<$_t0ݙ_t"01M|_ zo|߮fa|0  _|a|o|80 _|a| aK_Gj x    pLa a a~!a~a [Puo a~ha _8 LINE TOO LONG.a a~!a~ x  [ ""!p x ""   \\ `{ p_K4p "";p6 \\ `{  Gp_K( //`{ ** Uq K glX3a=gna0 0aao_6ao a=oav8o`  on ]:` aoaԢ:襕_10 0se poss. after addr ARCDMSK: EQU 0FF00 ...masks off AREFCD from hi-order of AREFTAB entry ADRFLGB: EQU 7 ...bit of hi-word of (host) addr, unused for addr, used for ... chain flag ...DATREFB: EQU 7 ...bit of hi-word of (target) addr, unused for addr, u oeae03a8efaa  0/еo:dae… !X9/70/t  *p] ߋ3/!aeO/7ae/aeą/ae¡ߒ6fП}/ /G _8BIT FIELD TOO BIG (OR 0) `|!3 _M2L|a|i{ qva|_Ma| _M2_GRc_ _Gf_GRs_ _Gb_GRC_,_,_Gb_GRr_,_,_Gba_ Ȟ`    !|!|1P   ׍Ea|  ` |_|a|_K_Kc 00ga [Pmu {psv  _r5 Pa a _ !`~Jaa I Y@Pu K K@C =e _ a_6a_ ӋC _ڜ$5  .`ev )`e~`ep! gf! gs  .c!Leagln gMg_ zog_GRE_ _Gb߱Leag_Magkg!gV㠶!gPc_Mag2 _M2_GRX_,_,sed to ... indicate data ref in RELOCTAB MAXREGNO: EQU 2 ...no. regs. avail. for accums.-1; later move to MACDEFS? ...registers for accumulators are numbered 0..MAXREGNO with size=max. needed ...these numbers are later translated to the actual reg. nos!Tߊ/@ م3/`!ae/ s1/nos1` B!1/n0Q0  f_8 SELF REF !`;eV  _8ILLEGAL FUNC DECL 4!8Y0o}` |n }T|V}a|a|ҙ7M|4!݈ a|0 _|M}L}T}a|a|Ҽ+u;M}L}a|a|̞00 E p_f_d_8_|0" !~ !   usn } P_ol0n }!}!|a\  _8#if's OVERNESTED UQf\n[\Po\a\P`[\ M\Ek\L\_,_Gb1P he` en[gjeЋLe` e`;g3_ h/g *` J e%`  _8UNSATISFIED GOTO e   aa׺g Η__. g J ` c . ...return reg. is no. 0: RETREG: EQU 0 ...the following refers to format of accumulator byte (as on ACCSTK in CODEGEN) REGMSK: EQU 0F ...holds register no. from 0..MAXREGNO RSZMSK: EQU 010 ...size of reg. for acc.: 1 (WRD)=word, 0=long WRD: EQU 010 .. 03`;ef0  PSRS"F߱ae݃TeQa 8e0  aeݠTe`aeae{ Ve]e_GRlD_Gf_GRlB_Gf_GRlC_Gf_M2_GRU_,_Gb_G^_,_ _Gba 8a3MeMeMeM!|_G^1 .{p`.{p_Gf8Y_it8_it9        }a|0 a|0 ǡ8Ya|Ўa|Бa|a|U8Й򡃡Ӏ_GRu_Gb_GRb_Le` en[g`eae0   _|n eՂ q  ae9  _in eaeae1agaeˋog!_i` eГLeВ"]eMe$MeLe_in eОՖ{n e`eLe"]eMeMe_i.additional bits of ACCSTK entry are def'd in CODEGEN ...CGTAB: ...code gen. symtab; tmp. here ... WORD 2+2*NCGHASH ...for len ... WORD 0[NCGHASH] ... ...--entries-- ... WORD 0[0100] ...tmp ... ORG CGTAB+CGTABSZ ...CGTABEND: ...AREFTAB: DEFS AREFTABSZfRa 8aofaoen eieMe _aen[eaeKeaeae`]eSkekeދaeګ03a1e!3aeځ3a3e/. LfOLfO_H"ӞMe IߋaeaeKe neae`;eਰaeoeޞLfOLfO Jh,_Gb_GRb_,_,_Gba|0 "a|a|_ol _M2a|0 ХЦ4ڽ4P a|Яаa|a|a|a|_ol _M2a|a|a|Sa|0 _|M}L}a|a|j`|   a|  _8CAN'T POINT TLeMe ` en[gneЗ88x_ z9լ8Q Ve]e֜$¡_ hg `  e aa_k(SeSeSeēʞWeWeWeaeogaeog Mgagā3o0gigċagag֬_H(Mg agā3a3g_k(k4  ...table of addr refs; tmp here ...RELOCTAB: DEFS RELOCTBSZ ...table of addresses needing relocation ...(or could request buffer from system) CGTABBSE: WORD CGTAB CGENDTAB: WORD CGTAB+CGTABSZ CGSYMP: WORD 0 ...gets ^cgsymtab entry FCDPOS: LONG CDPTUGE,FXALPX ...while R10@R10[AREFCD] WRW(R3:=R1; LDL RR4,RR12) ...symtab offset->mem. R13:+2 SUBL RR2,RR2 if RL7='A' or RL7='D' then LDL RR2,RR8 WRW(R3; LDL RR4,RR12) ...addr disp->mem R13:+2 R11:=SZPOINT if RL7=en SET CGFLG[R11],CGZAPB R10:+AREFENTSZ ...end JP FXALP FXALPX~ ...move down remaining code till CDPTR LDL RR2,CDPTR; LDL RR4,RR2; SUBL RR4,RR12 ...R5=CDPTR-PRVPOS MOVDOWN() ...updates FCDPOS LDL RR2,FCDPOS; LDL CDPTR,RR2 AREFPTR:=^AREFTAB resR0 ...fixed code pos. AREFPTR: WORD AREFTAB ...RELOCPTR: WORD RELOCTAB ...ptr into RELOCTAB ...RELOCFLG: BYTE 0 ...set=1 when RELOCTAB overflows ... BYTE 0 ...************** AREFTABI: PROC ...init AREFPTR,FCDPOS LDL RR2,CDPTR; LDL FCDPOS,RR2 AREFP LDL RR4,@R10; R4:&ARCDMSK ...RR4=chain ptr RESOLVCH(R3:=R11) ...LDL RR2,R11[ADRHI]) ...also passes RR4 ... RES CGFLG[R11],CHAINB end end else begin R11:=RDW(LDL RR2,RR8)+CGTABBSE R7:=RDW(LDL RR2,RR8; ADDL RR2,#2) ...**************************************************/ errno=0; /* open-write below assume 1st reg. var (errno_)->R6, 2nd (retval)->R7 */ open(name) char *name; { /* assumes 1st reg. var (errno_)->R6, 2nd (retval)->R7 */ register int errno_,retval; 'E' then R11:=SZENTR while R11:-2>>=4 do begin WRW(R3:=0; LDL RR4,RR12) R13:+2 end LDL RR2,RR12; SUBL RR2,CDPTR; INCCDPTR(R3) ... LDL CDPTR,RR12 end R10:+AREFENTSZ->AREFPTR restore R7..R13 RET FIXAREFS: ...have AREFTAB; go thru, rtore R7..R13 RET FDISPERR: Errm(); DEFT 'FWD REF WITH DISP' PUTCHAIN: ...enter with R3=^symtab entry, RR4=^memory, RL1=ref type code ('A'= ... init'n ref (set flag in chain), else=code ref) ...make (or add to) chain of refs to symbol RL0:=RL1; R1:=R3TR:=^AREFTAB R0==R0; RET CGTABINT: PROC ...init (clear) CGTAB R1:=CGTABBSE (2+2*NCGHASH)->@R1 R0:=0; R4:=NCGHASH repeat R0:->@(R1:+2) until R4:-1 zero; R0==R0; RET GETCGADR: PROC ...enter with R3=snum; ret. RR2=addr CGLKUP(R3); LDL RR2,R3[ADRHI]get disp. if any ... if RL6='A' then begin ...if idata ref to ftn ...label should be def'd (if undef'd, chain already made) ... WRADR_D(LDL RR2,R11[ADRHI]; LDL RR4,RR8) ... end else begin LDL RR2,RR8; SUBL RR2,RR12; R3->R1 ...R1=cuhexcode{35C20008BD507F40A0DEC600A137} /* LDL RR2,RR12[8]; R5:=0; SC 040; RL6:=RL5; RH6:=0; R7:=R3 */ errno=errno_; return(retval); } creat(name) char *name; { register int errno_,retval; hexcode{35C20008BD507F40A0DEC600A137} /* LDL RR2,RR1esolving sizes of refs, then move code ... down; if symbol undefined, make chain ...reset AREFPTR; update FCDPOS, set CDPTR=FCDPOS save R7..R13 R10:=^AREFTAB R12:=0 ...R12=CDADJ while R100 then NDFERR() ...chk not doing immx (NCDFLG in ZBAS) if BIT CGFLG[R1],CHAINB not zero then begin LDL RR2,R1[ADRHI] end else begin SET CGFLG[R1],CHAINB SUBL RR2,RR2 end if RL0='A' then SET R2,ADRFLGB LDL R1[ADRHI],RR4 WRMEM(R1; RET CGLKUP: PROC ...enter with symbol number to look up in R3 ...ret. R3,CGSYMP pointing to entry (add to table & set CGUNDEFB if ... not already there) save R8..R11 R8:=R3 R9:=CGTABBSE; R10:=0 R11:=(R8&(NCGHASH-1))*2+R9+(2-LNK) ...hash is lo-byrpos-PRVPOS MOVDOWN(LDL RR2,RR8; R5:=R1) ...updates FCDPOS R1:=SZPOINT if RL6='E' or RL6&0E0=0E0 then R1:=SZENTR ...R1=full size of addr ref/"enter func" LDL RR12,RR8; R0:=0; ADDL RR12,RR0 ...update PRVPOS LDL RR8,FCD2[8]; R5:=0; SC 040; RL6:=RL5; RH6:=0; R7:=R3 */ errno=errno_; return(retval); } close(fd) { register int errno_,retval; hexcode{31C300087F41A0DEC600A137} /* R3:=@RR12[8]; SC 041; RL6:=RL5; RH6:=0; R7:=R3 */ errno=errno_; return(retval); }  LDL RR8,@R10; R8:&ARCDMSK ...RR8=addr or R9=symtab offset if RL7:=@R10[AREFCD]='l' then begin ...if label or define R11:=R9+CGTABBSE LDL RR2,R11[ADRHI] if BIT CGFLG[R11],DEFNB zero then begin ...if label, adjust value R4:=0; R:=SZPOINT) ...store offset to prev member of chain RET RESOLVCH: ...enter with R3=^cgtab entry; RR4=^1st member of chain ...store value from cgtab; reset CHAINB ...if bit ADRFLGB of hi-word of chain in mem.=1, =>is init'n ref. save R6..R12 LDL RR6,Rte of snum CGLKLUP: repeat R1:=@R11[LNK]==0; JR Z,CGLKEND ...end chain R11:=R9+R1 if BIT CGFLG[R11],CGZAPB not zero then begin R10:=R11; JR CGLKLUP ...zapped spot can be reused end until R8=@R11[SN]; JR CGLKX ...found CGLKEND: ...noPOS if BIT CGFLG[R11],CGUNDEFB not zero then begin ...if not def'd ADJFCDPOS(R1) if R7<>0 then FDISPERR() ...can't make chain with disp. PUTCHAIN(R3:=R11; LDL RR4,RR8; RL1:=RL6) end else begin ...jp/call/addr ref to defined symbol ( read(fd,addr,len) char *addr; { /* assumes 1st reg. var (errno_)->R6, 2nd (retval)->R7 */ register int errno_,retval; hexcode{31C3000835C4000A31C1000E7F42A0DEC600A137} /* R3:=@RR12[8]; LDL RR4,RR12[10]; R1:=@RR12[14]; SC 042 RL6:=RL5; RH6:5:=R12; SUBL RR2,RR4 ...subtract CDADJ end else begin ...if define, get value from label R3:+CGTABBSE; LDL RR2,R3[ADRHI] RES CGFLG[R11],DEFNB end LDL R11[ADRHI],RR2 ...store fixed symbol value RES CGFLG[R11],UNFIXB 3[ADRHI]; LDL RR8,RR4 RES CGFLG[R3],CHAINB; R12:=@R3[CGFLG] repeat RDMEM(LDL RR2,RR8; R5:=SZPOINT); LDL RR10,RR2 LDL RR2,RR6; LDL RR4,RR8 ...args for below if BIT R10,ADRFLGB not zero then begin ...if init'n ref requiring abs. addr if BIt found R11:=R10 if R10=0 then begin R11:=R9+@R9 ...next free loc.->R11 if R3:=R11+CGENTSZ>=CGENDTAB then TUMANY() R3-R9->@R9 R1:=R9+2+(R8&(NCGHASH-1))*2 ...pt. to base link @R1->@R11[LNK] ...link in R11-R9->@R1 end R8:->@R11[SN] 4 or "enter func") ...bit RL0,7=1 or bit RL0,6=0 LDL RR2,R11[ADRHI] ADDDISP(R5:=R7; EXTS RR4) ...addr+disp->RR2 RL7:=RL6&01F; RH7:=0 ...size of jp or call or "enter func" LDL RR4,RR8; R1:=R7 ...args for PUT..()s: (also RR2) case RL0:=RL6&0E0 o=0; R7:=R3 */ errno=errno_; return(retval); } write(fd,addr,len) char *addr; { register int errno_,retval; hexcode{31C3000835C4000A31C1000E7F43A0DEC600A137} /* R3:=@RR12[8]; LDL RR4,RR12[10]; R1:=@RR12[14]; SC 043 RL6:=RL5; RH6:=0; R7:= if BIT CGFLG[R11],CHAINB not zero then R10:+AREFENTSZ ...go past chain ptr end else if RL7<>'A' then begin ...if jump/call/data addr/"enter func" ref. RDW(LDL RR2,RR8)+CGTABBSE->R11 ...^symtab if BIT CGFLG[R11],CGUNDEFB zero then begiT R12,BSSSYMB not zero then WRADR_D() else WRADR_C() RES R10,ADRFLGB end else begin R1:=SZPOINT if BIT R12,BSSSYMB not zero then PUTDATADR() ...passes RR2,RR4,R1 else PUTCDADR0() end LDL RR8,RR10 until TESTL RR10 zero; ...store snum SUBL RR2,RR2; LDL R11[ADRHI],RR2 ...0->adr SET R3,CGUNDEFB; R3:->@R11[CGFLG] ...0+2**CGUNDEFB->flag CGLKX~ R11->R3->CGSYMP restore R8..R11 R0==R0; RET ...AREFTAB with 'A','D' assumes SZPOINT=4 & can hold both ^symtab & disp. ... (otherf 080: begin ...if jp if R7<>0 then begin PUTJP() ...LDL RR2,R11[ADRHI]; LDL RR4,RR8; R1:=R7) ...ADJFCDPOS(R7-SZBASJP) R3:=R7-SZBASJP end else begin ...back up over jp (label next pos) LDL RR2,FCDPOS; SUBL RR2,#SZBASJP# /* ************************************************************************* * * * This program finds solutions to the following game: * * * * A triangular board has 15 holes, as shown in the diagram. * * Some holes have pegs in them, ann ...if def'd LDL RR0,R11[ADRHI] if BIT CGFLG[R11],DEFNB not zero then begin ...if label="define" R1:=@R11[ADRLO]+CGTABBSE; LDL RR0,R1[ADRHI] end LDL RR2,RR0; LDL RR4,RR8 ...args for GETJPSZ/GETCALLSZ,etc case RL7: orestore R6..R12 RET MOVDOWN: ...enter with RR2=current addr; R5=len of preceding data to move ... down to FCDPOS; update FCDPOS save R8,R9 if R5<>0 then begin R4:=0; LDL RR0,RR4 SUBL RR2,RR4; LDL RR8,RR2 LDL RR2,FCDPOS; LDL RR4,RR2; ADDL RR2,wise could add another entry) ST_AREF: ...enter with RL3=code ('l','J','C','E','A','D'), ... R5=^symtab entry; if not 'l', ^ref in mem is at CDPTR ...if 'A','D', RR0=disp. to be added to addr ...if 'l': symtab offset ->low word, else symtab offset ->1s; LDL FCDPOS,RR2 R3:=0 end end 0C0: begin ...if call ...ADJFCDPOS(R7-SZBASCALL) PUTCALL() ...LDL RR2,R11[ADRHI]; LDL RR4,RR8; R1:=R7) R3:=R7-SZBASCALL end 0A0: begin ...addr ref in "load" ...ADJFCDPOS(Rd some are empty. A move * * consists of jumping with one peg over a second peg to an * * empty hole. The peg jumped over is removed. Moves are * * permitted in any direction parallel to a side of the triangle. * * A solution results when exactly onef 'J': begin GETJPSZ()->R1; R0:=SZBASJP+SZPOINT; RH7:=080 end 'C': begin GETCALLSZ()->R1; R0:=SZBASCALL+SZPOINT; RH7:=0C0 end 'D': begin ...if unfilled-in data addr ref if BIT CGFLG[R11],BSSSYMB not zero then GETDADRSZ()->R3 RR0; LDL FCDPOS,RR2 if CPL RR4,RR8 not zero then MOVDATA(LDL RR2,RR8) ...@RR2'->@RR4' R1 times end restore R8,R9 RET ADJFCDPOS: ...FCDPOS+R3->FCDPOS R2:=0; ADDL RR2,FCDPOS; LDL FCDPOS,RR2; RET FIXDECSP: ...enter with RR2=am't to fill in for dec t word of ... addr place in mem.; if 'A','D': disp ->2nd word in mem. (could ... also add another entry) ...store in AREFTAB, inc AREFPTR; update CDPTR by size of ref. ...if 'l' & chain, chain ptr ->next entry with code 'c' ...for J,C,A,D,E: also fill7) if BIT CGFLG[R11],BSSSYMB not zero then PUTDATADR() else PUTCDADR() ... PUTDATADR()...LDL RR2,R11[ADRHI]; LDL RR4,RR8; R1:=R7) R3:=R7 end ... 0: begin ...code addr ref ... ...ADJFCDPOS(R7) ... PUTCDADR() ...LDL RR2,R1 pin remains. * * * * DIAGRAM * * 1 * * 2 3 * * 4 5 6 * * 7 8 9 10 * * 11 12 13 14 15 * * * * INPUT is a list of hole numbers that are to be empty. * * * *  else GETCADRSZ()->R3 R1:=R3; R0:=SZPOINT; RH7:=0A0 end ... 'a': begin ...code addr ref ... GETCADRSZ()->R1; R0:=SZPOINT; RH7:=0 ... end else begin ...if 'E' GETENTRSZ()->R1; R0:=SZENTR; RH7:=0E0 end end R12:+R0-R/* basic i-o routines for C on ZOOMSYS */ /* putchar, getchar, open, creat, close, read, write, lseek, printf, scanf */ /* (also have length) */ putchar(c) { hexcode{31C300087F45} /* {R3:=@RR12[8]; SC 045} */ } /***********************************s to SZPOINT or SZENTR with 0 ... (here assumes SZENTR & SZPOINT are at least 4 & even) save R7..R13 LDL RR8,RR0; R11:=R5; RL7:=RL3 if AREFPTR+(2*AREFENTSZ)>(^AREFTAB+AREFTABSZ) then FIXAREFS() ...if table full, resolve refs in it R10:=AREFPTR R1:1[ADRHI]; LDL RR4,RR8; R1:=R7) ... R3:=R7 ... end 0E0: begin ...if "enter func" if R7<>0 then begin ...ADJFCDPOS(R7) PUTENTR()...LDL RR2,R11[ADRHI]; LDL RR4,RR8; R1:=R7) end R3:=R7 end else begin ...if Program Written By: Gil Berglass * * The MITRE Corporation * * McLean, Virginia 22102 * * (703) 827-6087 * * * ************************************************************************* */ /* the "connect" table shows 1 ...update CDADJ RH7:|RL1->@R10[AREFCD] ...put size of jp/call in table end end R10:+AREFENTSZ end ...now go thru again, fix jps/calls/abs. refs, move code down R10:=^AREFTAB; LDL RR12,FCDPOS ...RR12=PRVPOS FXALP~ R10==AREFPTR; JP ******************************/ static char _BUF[144]; /*BUFLEN=144*/ static int _BUFIDX; static int _RDCNT=0; getchar() { /* assumes 1st reg. var (buf)->RR6, 2nd (rdcnt)->R8 */ register char *buf; register int rdcnt; buf=_BUF; if ((rdcnt=_RDCNT)=R11-CGTABBSE if RL7='l' then begin R0:=0; LDL @R10,RR0 ...symtab offset RL7:->@R10[AREFCD] if BIT CGFLG[R11],CHAINB not zero then begin R10:+AREFENTSZ LDL RR2,R11[ADRHI]; LDL @R10,RR2 B.'c'->@R10[AREFCD] end end else begin addr ref in init'd data ("A") if BIT CGFLG[R11],BSSSYMB not zero then WRADR_D() else WRADR_C() ...LDL RR2,R11[ADRHI]; LDL RR4,RR8) R3:=SZPOINT end end ADJFCDPOS(R3) end ... end end if BIT CGFLG[R11],CANZAPB not zero th5 the connectivity of nodes 1-15. the order is ne,e,se,sw,w,nw. */ int connect[16][6] = { {0,0,0,0,0,0}, {0,0,3,2,0,0}, {1,3,5,4,0,0}, {0,0,6,5,2,1}, {2,5,8,7,0,0}, {3,6,9,8,4,2}, {0,0,10,9,5,3}, {4,8,12,11,0,0}, {5,9,13,12,7 = c->mover; path[ppath].jto = c->mto; path[ppath].jfrom = peg; if( count == 1 ) return( 1 ); goto next_step; } } } if( ppath == 0 ) return( 0 ); state[path[ppath].jover] = state[path[ppath].jfrom] = 1; state[path[ppathER1> FININIT ; INITER1 := INITNXT := "{" INITLBR INITRBR "}" := STRINIT ; INITLST := $(Wh "," {}) ; CONEXPRI := ( / "&" Wh / ) FIXCONXI ; ...later poss. allow offsrn( 0 ); c = getchar(); while( (c < '0') || (c > '9') ) { if( c == '\n' ) return( 0 ); c = getchar(); } while( (c >= '0') && (c <= '9') ) { v = 10*v + (c - '0'); c = getchar(); } lastchar = c; return( v ); } instate() { /* as***************************************/ /* atoi.c ascii to integer conversion routine */ atoi(cp, len, ip) register char *cp; int len; int *ip; { register int l, i; int sign; char c; /* check for negative */ sign = 0; if ((l = len) && *c,4}, {6,10,14,13,8,5}, {0,0,15,14,9,6}, {7,12,0,0,0,0}, {8,13,0,0,11,7}, {9,14,0,0,12,8}, {10,15,0,0,13,9}, {0,0,0,0,14,10} }; /* an MNODE describes a move. the "mto" field is the position moved to; the "mover" field is the p].jto] = 0; ppath--; count++; goto next_step; } main() { again: init(); if( count == 15 ) return; printit(); while( win() ) { printit(); listpath(); } printf("\n --- ALL SOLUTIONS HAVE BEEN PRINTED ---\n"); goto again; } ); whiets PARMLIST := PARM0 $(Wh "," ) ; PARM := Wh .SAV(*) ADDPARM ; FUNCBOD := FUNCBEG $ FIXPARMS FUNCEND ; FUNCSTMT := FTNSTMTI FTNSTMTX ; PTYPDECL := INITDCL ; PTYPESP := Wh Sk the user to list those positions containing pegs. return a state descriptor bit mask */ register int bit; printf("\nenter initial configuration as list of positions without pegs:\n"); for( bit = 1; bit <= 15; bit++ ) state[bit] = 1; count = 15;p == '-') { len--; cp++; sign = 1; } for (i = 0; l; l--) { if ((c = *cp++) < '0' || c > '9') break; i = i * 10 + (c - '0'); } *ip = sign ? -i : i; return (len - l); }  { if ((c = *cp++) < '0' || c > '9') break; i = i * 1osition jumped over. */ typedef struct mnode { int mto; int mover; struct mnode *mnext; } MNODE; /* for each position (1-15), the list in the "move" table describes all legal moves. */ MNODE *move[16]; /* MNODEs are allocated from "mle( win() ) { printit(); listpath(); } printf("\n --- ALL SOLUTIONS HAVE BEEN PRINTED ---\n"); goto again; } } ain; } BEEN PRINTED ---\n"); goto again; } again; } TIONS HAVE BEEN PRINTED ---\n"); goto again; } ALL CREG {TYPESP_I} / SCAUTO ; /ZAPALL TMPS /PACKALL  c LSTRBUF: EQU 140 STRBUF: DEFS LSTRBUF DECFLG: BYTE 0 ...set=1TMT> FUNCEND ; FUNCSTMT := FTNSTMTI FTNSTMTX ; PTYPDECL := INITDCL ; PTYPESP := Wh S while( bit = getnbr() ) if( bit <= 15 ) { count--; state[bit] = 0; } return; } init() { /* processes the "connect" array to build the "move" table. initializes everything needing initializing. */ register int i, m, p, q;nspace". "mnavail" is the index of the next free mnode cell */ # define MNSIZE 300 MNODE mnspace[MNSIZE]; int mnavail; /* the "state" vector describes the current state of the game. a 1 in a position indicates the presence of a peg; a zero indicateet; { /* assumes 1st reg. var (errno_)->R6, 2nd (retval)->RR8 */ register int errno_; register long retval; hexcode{30CB000935C4000A31C1000E7F05A0DEC6009428} /* RL3:=@RR12[9]; LDL RR4,RR12[10]; R1:=@RR12[14]; SC 5 RL6:=RL5; RH6:=0; LDL RR8,R mnavail = MNSIZE - 1; for( m = 1; m < 16; ++m ) { move[m] = 0; for( i = 0; i < 6; ++i ) { if( p = connect[m][i] ) { if( q = connect[p][i] ) move[m] = newmnode(q,p,move[m]); } } } lastchar = 'X'; instate(); ppath = 0; for( i s the absence of a peg. "count" is the number of 1's. */ int state[16]; int count; /* the "history" table indicates positions already seen. the state is treated as a 15 bit number; the "history" table is treated as a 32768 entry bit vector (4096 8-R2 */ errno=errno_; return(retval); }  =0; LDL RR8,RR2 */ errno=errno_; return(retval); } 6:=0; LDL RR8,RR2 */ err0935C4000A31C1000E7F05A0DEC6009428} /* RL3:=@RR12[9]; LDL RR4,RR12[10]; R1:=@RR12[14]; SC 5 RL6:=RL5; RH6:=0; LDL RR8,R= 0; i < 4096; ++i ) history[i] = 0; } listpath() { /* list the jumps as a->b involved in the solution */ register int i; for( i = 1; i <= ppath; ++i ) { if( i == 10 ) putchar('\n'); printf("%d->%d ",path[i].jfrom,path[i].jto);  Wh := OUTJPF {Wh OUTJP EXC OUTLAB } OUTLAB ?";" := LUPENTRY LABELSV OUTJPF DEFCONT EXC OUTJPRe OUTLAB DEFBRK := LUPENTRY LABELSV DEFCONT Wh OUTJPT bit characters). */ char history[4096]; /* the "path" vector describes the current path as a sequence of positions. "ppath" is the index of the current position. */ struct { int jfrom; int jto; int jover; } path[16]; int ppath; char lastch5  } putchar('\n'); } int dejavu() { /* examine the current state. if we've seen it before, return 1. otherwise, return 0--but remember this state for another time. */ register int box, bit; register int i; box = 0; for( i = 15; i > 0; i--OUTDEFLAB Wh ";" DEFBRK := LUPENTRY Wh "(" {} Wh ";" LABELSV { / SVCON1} Wh ";" OUTJPF EXC (Wh ")" / OUTJP EXC LABELSV EXC OUTJPRe EXC OUTLAB Wh ")") DEFCONT OUTJPRe OUTLAB DEFBRK := SWENTRY OUTLDSar; /* the last character read */ char posprt(p) int p; { /* return "*" is position p (1-15) contains a peg; "-" otherwise. */ return( state[p] ? '*' : '-' ); } printit() { /* prints the current position at the terminal (centered on an ) box = 2*box + (state[i]?1:0); bit = 1 << (box % 8); box /= 8; /* for( i = 15; i > 0; i-- ) box = box+box + (state[i]?1:0); bit = 1 << (box & 7); box >>= 3; */ if( history[box] & bit ) return( 1 ); history[box] |= bit; return( 0 ); } win() W OUTJP OUTBRK OUTLAB DOSWTCH DEFBRK := LABCASE Wh ":" := Wh ":" := OUTBRK Wh ";" := OUTCONT Wh ";" := { FIXRETEXP} Wh ";" OUTRET := Wh .SAV( 80 character line). a pin is indicated by an "*"; an empty position is indicated by a "-" */ printf(" %c\n",posprt(1)); printf(" %c %c\n",posprt(2),posprt(3)); printf(" %c %c %c\n",po/DO BASICIO.C /*includes printf*/ /DO HOJOB.C #/LIST /WRITE "Type in:" /WRITE "/IMAGE HOJOB E=main"   { /* if only one peg remains, we have "won" (i.e. found a solution), and we return a 1. Otherwise we attempt a move from the current position. If we find a move we make it and adjust the state. If not, we undo the most recent move and try an alter*) DCLULAB OUTGOTO Wh ";" := Wh "{" $( OUTHEXB) ALCODE "}" ...addition := .SAV(*) DCLLAB Wh ":" := Wh ";" := ";" ; ...PROGRAM := PREPROS $(Wh ) ; EXTDEFN := INITDCLX SCEXT {TYPESP_I} mnext ) { if( (state[c->moverST> := SCSTAT {TYPESP_I} := SCTYPDEF := SCEXTDEF {TYPESP_I} ; F_IDECLST := ( DCLEXTF SAVFTNTYP / DCL_INIT $(Wh "," ) ";") := ";" ; F_DECL0 := CLRDECFLewmnode(pto,pover,pnext) int pto, pover; MNODE *pnext; { /* create a new MNODE, and initialize it */ register MNODE *p; if( mnavail < 0 ) { printf("ran out of free space -- abort\n"); return; } p = &mnspace[mnavail]; mnavail--; p->mtp++ = '-'; val = -value; } ncp = locbuf; do { *ncp = (val % base) + '0'; if (base == 16 && *ncp > '9') *ncp += 'A' - ':'; ncp++; } while ((val /= base) != 0); /* copy back */ do { *cp++ = *--ncp; } while (ncp != locbuf); return (] != 0) && (state[c->mto] == 0) ) { state[c->mover] = state[peg] = 0; state[c->mto] = 1; if( dejavu() ) { state[c->mover] = state[peg] = 1; state[c->mto] = 0; continue; } count--; ppath++; path[ppath].joverG DCL0 ; DECL1 := Wh .SAV(*) DCLNUL ?(Wh "(" MARKFUNC ? ")" DCLFTN / ARYSUBS) := "*" DCLPTR := "(" Wh ")" DECLSUB ; IDECL := DCL_INIT ; DCL_INIT := Wh "=" DCLEXTI / DCLEXTU ; INITER := INIT0 mover = pover; p->mnext = pnext; return( p ); } int getnbr() { /* find, and then convert the next digit string; return the value, or zero on newline. */ register char c; register int v; v = 0; if( lastchar == '\n' ) retucp - buf); } /************************************************************************/ length(cp) register char *cp; { register int len; for (len = 0; *cp++ != '\0'; ) if (++len > 256) break; return (len); } /*********************************6 h!Êl_BiBi~!rh Ti di {i Ói pj j j j" 7k 6 w * KDDS\LDDDS $OeKKG]G;D DSKD(*** l:KK CLL3HfW""+L $O"  K; val = value; if (base==10 && value < 0) { *cp++ = '-'; val = -value; } ncp = locbuf; do { *ncp = (val % base) + '0'; if (base == 16 && *ncp > '9') *ncp += 'A' - ':'; ncp++; } while ((val /= base) != 0); /* copy back */ do { *  !7.X3.XC: : :::13L8g7Q7^5f8~b8~{?P   g7 7Q7A  < -7 X2 c-  len = length(frmt); while (len--) { if ((c = *frmt++) != '%') { putchar(c); continue; } /* format specification */ /* pick up type */ if (len == 0) break; /* end of string */ len--; c = *frmt++; fwidth = precision = 0; tic inputsr(strp,maxcnt) /* input string to @strp, dest. has space maxcnt+1 */ /* special case: if maxcnt=1, don't add \0 */ /* ret. last char. input */ register char *strp; register maxcnt; { register in_c,maxcnt0; maxcnt0=maxcnt; do in_c=gev 41a11pC_H_GMa"00o"a-_ d ERROR _ "a- B 901pL!h:a*_ VL!o .[V !s09p?.xp:V_ LНL<a! t!La߷cp++ = *--ncp; } while (ncp != locbuf); return (cp - buf); } /************************************************************************/ length(cp) register char *cp; { register int len; for (len = 0; *cp++ != '\0'; ) if (++len > 256) break; A( #   ^hB⠉o  f8^ ~b8{^ :{Ѐ:: :4::~ ߼:::78 39  '2' ! 2::4:%1#2 /* check for possible width specifier */ if (c < 'A') { cnt = atoi(--frmt, ++len, &fwidth); frmt += cnt; len -= cnt; /* check for precision specifier */ if (len == 0) break; if (*frmt == '.') { frmt++; len--; if tchar(); while (in_c == ' ' || in_c == '\t'); while (in_c != ' ' && in_c != '\t' && in_c != '\n' && in_c != -1) { if (maxcnt != 0) { --maxcnt; *strp++ = in_c; } in_c=getchar(); } if (maxcnt0>1) *strp='\0'; return(in_c); } static inputnum(base,^Hޕ! }2?}:]      ;;ʽ x   ;;!  ! }2?}:]!_ d/DO ! oL<݈L=_GL=M8M8 \4! ]4T4$"]4   騐  return (len); } /************************************************************************/ /* atoi.c ascii to integer conversion routine */ static atoi(cp, len, ip) register char *cp; int len; int *ip; { register int l, i; int sign; char c; 103$j8&2$#j8:ȃ:!1!:B !<$G<%<-<#<+5+1+7+3+!!1!: @5+7+M8L8/L85`L8<T@:J2L8L(len == 0) break; cnt = atoi(frmt, len, &precision); len -= cnt; frmt += cnt; } /* pick up true format char */ if (len == 0) break; len--; c = *frmt++; } base = 10; switch (c) { case 'o': base = 8; gotvalp) /* input number of base base to @valp */ /* ret. last char. input */ long *valp; { register in_c,sign; register long value; value=0; sign=0; do in_c=getchar(); while (in_c == ' ' || in_c == '\t'); while (in_c != ' ' && in_c != '\t' && in_    #!4e2u!!B .xp!s 8C0 ??  % ??   ~;^X`ݞf;E!ss1aa0oas1p s!of;!CM /* check for negative */ sign = 0; if ((l = len) && *cp == '-') { len--; cp++; sign = 1; } for (i = 0; l; l--) { if ((c = *cp++) < '0' || c > '9') break; i = i * 10 + (c - '0'); } *ip = sign ? -i : i; return (len - l); } /******81+!.(o8K83+L80 8!8ĞjL8< 4 B:@_`TR7 …U7)x 7)p 4)p  ߲Ȁ($ O  pp o unsigncase; case 'x': base = 16; /* goto unsigncase; */ case 'u': unsigncase: value = *((unsigned *) argv); argv += sizeof(unsigned); /* *((int *) &value) = 0; */ goto numeric; case 'X': base = 16; case 'D': c != '\n' && in_c != -1) { if (in_c == '-') sign=1; else { if (in_c>='a') in_c &= 0xDF; if (in_c != 'X') { if ((in_c -= '0') > 10) in_c -= 7; value=value*base+in_c; } } in_c=getchar(); } if (sign != 0) value = -va!oa`ߕLL;_WRITE`Ld;n!/`"`<c!!!Bء7 ^cD$!u`<j<_OPENo!1. {p {******************************************************************/ /* scanf.c - C implementation of Unix */ /* formatted I/O routine */ /************************************************************************/ static double ascflt(buf) /* enter OAȀ  H  4*m! H.(0P4*P.I驓 I PNE4(p 7CU5)a8x5'  B!B>S T4   K8r!7)5o8x5)v7value = *((long *) argv); argv += sizeof(long); goto numeric; case 'd': value = *((int *) argv); argv += sizeof(int); numeric: cp = buf; cnt = cnvt(cp, base, value); break; case 'f': cp = buf; getfltsr(*((double *) alue; *valp=value; return(in_c); } /*********************************************************************/ /END SECTION /* get rid of static symbols */  hexcode{31C300087F45} /* {R3:=@RR12[8]; SC 045} */ } /***********************************u5  ;,<>=*" !! ~~ !TEU 8  0P` < ^h<!ЁpT /g7bЊ]Lߍ!^`:!_ d ERROR TOTAL=_ "=!< XҤ*PL Y !Ё!g5d]߻L<6  with ascii string representing floating pt. number in buf */ /* calc. & ret. floating pt. value (makes ZOOMSYS call) */ char *buf; { register char *buf2; buf2=buf; /* RR6=fval */ hexcode {94627F50} /* LDL RR2,RR6; SC 050 */ /* ret. RR2 */ } )x1)ropFg`upF5)RݟFp6eFfc0cpFc g6SuFeQ!Gg/G5S3B3ݿ5(H5SFYyw0&7Yi0&)cF\ 85BS77(13(K3o58+3rgv), cp); argv += sizeof(double); cnt = length(cp); break; case 's': cp = *((char **)argv); argv += sizeof(char *); cnt = length(cp); break; case 'c': cnt = 1; cp = (char *) argv; argv += sizeof(int); /*# ifdef Z8벱SKvXQa ` Tg3 ! !  ! !5 !0 13 ! !. / !7 !2 3YњѲѴ|!4\5q*La^XrL<%! q^ q^uss0!1Q0TҖ] `L`ѫL:!ќoo ! ɞ_READ!71!117!!xbckV _/************************************************************************/ scanf(frmt, i) char *frmt; char *i; { register char **argv; register int in_c, count; register char *varp; int len,base,maxcnt; long value; char buf[25]; /* bufsiz=a38. *QI/I/\8y8\ 813!o8.\8{M8L8/ Ȅ:: „!7&^&О5'̞4 &&A $. ‘6L8!Hȇ000 */ cp++; /* byte passed in odd address on Z8000 */ /*# endif */ break; default: putchar(c); continue; } /* output 'cp' according to fwidth & precision */ /* limit field width */ if (precision && cnt > precision) cnt = pre` #8 ` #8γ94q?6` #89eRм!4^М5qj!ў o n ]С5qЋЯ6` #8-9eО¡5*WM8 M8RELOC. TABLE FULLT4A 8ߙߝqߡi8UHa }T!@} N(cVT!@}:N0fE]da!VrfbTPP!1pa }R_}Z (}R_}Z.(25 */ argv = &i; len = length(frmt); count = 0; in_c = 0; while (len--) { if (*frmt++ != '%') continue; /* format specification */ /* pick up type */ if (len == 0) break; /* end of string */ --len; base = 10; varp = *argv; maxcnt=L (0  R U[G2NL8]ȁaciWyg75%7{ f''^ ^ ^< ?^ >^ ~11 '@ ; O6 $1  Ќ, 2' 3" в .  Г cision; while (cnt < fwidth) { fwidth--; putchar(' '); } while (cnt--) putchar(*cp++); } } /************************************************************************/ static getfltsr(fval, buf) /* turn floating pt. value into ascii stqЬf 22 ssR9S³chV`cq W 11 r ss ssñÂҋ 44k҅ ss ss! Ãҡқ 22ÍҧÒkҸÒ벱kҾÔkŗ ddR3 */ errno=errno_; return(retval); } lseek(fd,offset,type) long offset; { /* assumes 1st reg. var (errno_)->R6, 2nd (retval)->RR8 */ register int errno_; register long retval; hexcode{30CB000935C4000A31C1000E7F05A0DEC6009428} /* RL3:=@RR121000; switch (*frmt++) { case 'X': base = 16; case 'D': if ((in_c=inputnum(base,&value)) == -1) break; *(long *)varp = value; break; case 'x': base = 16; case 'h': /**** must change if short<>int ****/ case 'd':  Г Л Ё ŕ{ 1 1 {   ߨ Ѡ3a;!  &ˍCwa{! &554 $&  ring (makes ZOOMSYS call) */ double fval; char *buf; { /* assumes 1st reg. var. (fval2) ->RR6, 2nd (buf2) ->RR8 */ register double fval2; register char *buf2; fval2=fval; buf2=buf; /* RR6=fval, RR8=buf */ hexcode {946294847F51} /* LDL RRIV1.00 4!}:o*oo o ],!V]! p] ]!}x>q>y>r>z>s>{>v>~>t>|>u>}>v>~ĕb8~L8~?2,RR6; LDL RR4,RR8; SC 051 */ } /************************************************************************/ static cnvt(buf, base, value) char *buf; int base; long value; { register char *ncp, *cp; unsigned long val; char locbuf[14]; cp = buf78 88&848B8P8^4.x!p4.nT $G7B]4/!0:J70L84CON4-4!@B_5 潒baL8L8!o8r!! %UU !UU % !/!a` ^B!O routine */ printf(frmt, i) register char *frmt; int i; { register char *argv; /*so can increment normally*/ /* **argv; */ register int c; register int len, cnt; int fwidth, precision, base; long value; char *cp, buf[25]; argv = (char *) &i;n_c=inputsr(varp,maxcnt); break; default: continue; } if (in_c == -1) return(-1); ++argv; ++count; if (in_c == '\n') return(count); } while (in_c != '\n') { if (in_c == -1) return(-1); in_c=getchar(); } return(count); } sta7 b8L8>a8¡]4_`M8a8…U AȆ>H>M4:"@M8žW*w@L8=L84za8i  .`   .` po8…L8 L8i3Q@iL8s}a8#T#`#a# f#d!9f# q d!&`#Ԟ{Ԣ{@!] #n#o#  pԾT #`#a#w  !Ҟ{ X !h] #ޠ n #so#T #`#!A2 CPB @R7,M_Ddefine U_I2_Dߖz]9._Dundefg_I2_Dޣ_Dincludeu_D<_D"_D_D_DR߇_Difdefߎ_I2_Dޮ_Difndefߜ_I2_D޵_Dif҃_D޹_Dendifދ_D_Delseޡ_D_$`(! `dO(qwhcvyps3c27p߲]dT`ic桢qTd@x]w   * wB1 .kp.k}} ]>! ? !  ! @- 90100-(00 99...800 99. !@ {p  먐    #K8 ! (o8ȀЏ  qȀ &/ .k !.kҡ=Ȁ  L8_`Ȁ M8ȀM8L8L8!8o8o8(<=]]J 3& ˡ Zy!Ղ] #ڠ n #so#@!չ] #n#o#T #`#a#@!հT#`#a#զ] #n#o#q] #n#o#jI!UM!T#`#a#@!T#`#a#X !؞a_ _  ^_>c !^_ L^M^]o ^_D(_D_D,_D_D)_D_I2_D x    pL^ a ^!^a [Puo ^h^ _8 LINE TOO LONG.a ^!^ x  [ ""!p//%w @߳ !      ++ -- 00 99߹ ..  00 99ʫ) EE ee1 --5Ƀx V2!C7 }3 813 257 ,\  AD@!@}Ѐ~ BREAK AT TAdzZ` -  GG JJ DD߷ RR SS PP!@!P9?`!@^aAd  RR  HH]Ad}} a ֊n  . ա      ި      ^  @@0ɗ ߾ f  ݯT#`#a#,ՠՂ{\U!] #n#o#o#wq] #o#n#EJ!3] #o#n#T #a#`#qIcߜ!u] #o#n#T#a#`#f] #o#n#T #a#`#T#a#` x ""   \\ `{ p_I4p "";p6 \\ `{  Gp_I( //`{ ** Uq _I_I2c 00ga [Pmu {psv  _z5 Pa ^ _ !]J^a I Y@Pu K K++<Ёx!TP!  qr9諀  詀*" * p 00 99  ~w;P!  qr{諀 M詀  PX詀 vg A`}\A@yA`A@-͑1 ,,0& . .|.s   .. |.* }bғC5X bA}R_}Z (}R_}Z.(0_}ZX2 c- Kh8"Ѩ&Ȁ&0  S 0 &2$.&Ȁq&$5BB303%%5 5BɞB5%1% $\5 %0#֤T#a#`#xa# L(!֘ Zy!֣ k~e!֮a#YsS7{QB] #o#n#*]#o#n#ӹ]#wT #a#`#ѴT#a#`#c\# @!oT#@C =e _  ^_>a_ ӋC _$aZ.  _8#if's OVERNESTED UQfZ$n[Z$PoZ.aZ.P`[Z$ MZ.EkZ.LZ   E++ E--P E..P *ު EEEP  E--P E++P E  00.IPn00.FP APbSE{m^P{xi[{уtf{юѠO}JaT^Xdo}2oaK?K aK  @?!@SS a}:a^HB_HL_Ga @_l_D q _V! }2oLE`_NLKM q// p_B$$0֫+8LKM!Wv_D q _Ga"o_`DSGСc}߽)!c % 5 $P5 @B7 c1S9 05 `Ȁɞ0P!@!@ ߩ%l0|6ފވ '0a1111011'11Ȁ!T #a#`#O$@P]#] #o#n#q @!] #o#n#M# T#M]#(k#$] #o#n#qIT#M]# T#a#`#\k#k#M#-:JL>}2?}:a >J{*l{{ѣh{ѭя{ 1 (  0 !4ȅ!@ H4$уѼ{ 1 (0.HP{4|4v!W_HZ!W}: - case of not ascii type (otherwise reset below) ... if R3<>0 then begin ...if not ascii ... R1:=LINKAD ... if BIT R1,0 zero then begin ... FILLU0(); RL3:=RH0 ...pass LU in RL3 ... CALL @R1 ...LINKER should ret. }4!.'閭 213033'Ȁ''ɗ51@E B1@E B5364~ҿ'6 7 2c %333 ::CՕ ::5 & ''Ɋ'05 11@E %h7 !L>` -!?!l^M>Jߐ l ;;   // //[ ## ߡߓj8!   XXT - **K*  II o >JH !>Zo? o >h>] - ,, ޽o >J}Q|!҄mo# q @!Ҙ] #n#o#qҢ] #n#o#G!T#`#a#ҼC!] #n#o#T #`#a#dm'!j6T!T#`#a#a#   qT Z=0 iff bad header ... ... inLYLYLY%LY" x ##LZ ## pLY݀ݼLY_I LZ_E_2_EtaZ.UP`[Z$ CMZXLZLZhZLZ _8MACROS OVERNESTEDbZ8'%ᢗ(ᦗ'ȀщО5 ‘%1% $P5 %6Е!  c % 5 $U3c % 5B c 09 }Н<3Ȁ  c % Ž@B5Bc}c}'c}+A5} ]莞        ;;   .  󡕃5  ;,<>=* !! ~~ !/hTEM>Jݣݼ F GFILE NOT FOUND\n F GWRONG FILE TYPE\n F G%B???\nF Lc@Mb abn[c2435 > = ?6789abUoSc 0abUoScab3a3c 9abUoSc Mc2Mc4!ڞ! ޞ9#`#a# T#`#a#҇a#/{qw   $GOD ҙq8Q|!?(Qo#{Q|!N7o#{ q @!da# c] #n#o#qx] #naZoZfZLZ!XoZ`YLZLY x  ,"_I2 xp "" 9`{ \\dY ''1 // { **pdYfZs0aZ0oZ a_ _ _ CaLZ !YaZ AqIPWpoZfZ @B7 5B75 T%'13 ý %6` 11S06'`^^Ȁ###0#%##%Ȁ%Ȁ4@ :I '8RV"""""###,#T#%%v$'T)X+,v1?  "G???\na- .. /093 00 99 AA FF aa ff  AAߴys!>p!x!Bء8 !  M>psXsDB!>p L>p##L>s<ҍCЯ mk6_z8/d_5!0ab3a3c abUaUcP8Ya c2 0 0 a c4aЩ ֡0/ӡao c4o 0 _ء A c2 o c2#o#C@0!ӭ] #n#o#T #`#a#X,!}ӡJQ!T#`#a#Ӳi!T#`#a#ӲT#`#a#Oq] #n#o#__!] #n#o#T #`#a#r|!aZoZHoZLZaZaZ1AS YݵAPoZ` { (("fogZ p x ,, )) _8MACRO REF >1 LINE`c3o7Z p ))oZ" x  Ep "" ''ɞ (( { ))p // { **pƞ x  "" { a"3!-{Д$1 ?1 0 !{B1 _1   !{!2/!{ }63 5.75*7{5! 00,$wU 8  0PV!>Nt1@.K! `x // ::!>L0.X/nXޞ   uު` >>a c e` >>aec  ;; << >>C6hL,!>N1.cAe!>N!@  4  > 7]c {8ಁ00 99.hp (0 A7!>p!Aa ҋ!hs@5j af! >a3 5aa7̡6"0! JC']>]>a<_Cf}} $00(   % 0}} ]>!5   ;; <<Lc6 Lc6ac:Nj`  `c6      5Pc< Lc6Lc6aaKc86f f`caf_>ffac_>` c@J Ce Ќe _D`91p_D_] #n#o#T #`#a#ԒT#a#`#ԈL# T #`#a#] #n#o#qԴ] #n#o#T!T#`#a#eG!] #n#o#T #`#a#e2!eG!T#`#aޠo Z Getrec if INLVL=0 and DBGFLG<>0 then begin R15:=SAVSP; JP DBUG2 end ... Getrec: PROC ...enter with DE pointing after CR (or START) ...assure another CR in buffer if INLVL<>0 then begin ...chk if getting from file or console R3:=^DATPP!`'d  -.hp24!A/ 00 .hpQ P !`W5p w @qp  !b paq*;v  0b/* L >>    60/caqW  /iap s'Y2!B .80.8T>P>T>ߜj>a >}} H?!  / $$" 11 99 0K? 3a5>!U HPk.hp.hp 8 F` c aabUoSc aabUoSc_]c<` c nc6Mc8Mc: a_ c `  a 52_Ea_ ` ab3a1c      c aabUoScab3a1c oc8   ` c nc6Mc:"]c<0 0 aza9 ԋ8Taz0  az_Jcaz_J߸gLzpОfLzpܞaz    az!3 _JTz# _JTz_JTz_J_D.{p_D_ _ _ _D_ _ _D x nn  tt  bb rr  ff p@_E! x "" \\ `{ p_I Y. Z_ .Ρ8_z1!κQ mS_g {op {EpC=&| { ((p_D9C { V_D_DZ_ V_DX QЯs_>Kc3a9dPUaUc#-MdܞMd _8TOO MANY PARAMSMc8Mc:Lc6"]cao a=oaP8o`  on B:` aoaԇ:襕z azߴaz a߾a_> oanz%0__DJT_ _ _D_DJF_ _ _D_DJ_D_DJA_ V_D_s_DlC_ V_DS_Dd_ V!_ V_D_s_ ^oz&-Lz%0P״ν ab`;c  ac2  _8 WRONG TYPE _ oc2_ oc2ab03a8cfaa  0/лo:dac2 !X9/70/t  *pc ߋ3/!ac2O/7ac2/ac4/c_ V_D_Ds_ V_D_DC_ _ _D_Dr_ _ _Da_ `    !z!z1P   ׍Eaz  ` z_kazoz&` zn z%TzVz azazҙ7Mz4!݈ az0 _kMz&Lz%int.$char5+float<2doubleD:structLBunionSIlongZPshortaWunsignedj`autoqgexternyoregister߂xtypedefߊ߀staticߒ߈gotoߙߏreturnߡߗsizeof_10 05  .`b )`b`bp! ef! es  .c!Lc@adn eMe_ ^oe_DE_ V_D߱Lc@ae_Jaeke!eV㠶!ePc2az0az a7a_>J(M_DF_ _D0Q 0_kC 0_k0 0  ՠׁaza za z!8a zs_Rjn_{lשLzLzac2ߒ6fХЃ/ /G _8BIT FIELD TOO BIG (OR 0) `!Tߊ/@ م3/`!ac2/ s1/nos1` B!1/n0Q0  Tz azazҼ+u;Mz&Lz%azaz̞00 E p_f_d_8_k0" !* !,   usn z)P_l0n z(!z(!(!(_Dܡ1 .{p`.{p_D8Y_f8_f9    ߩߟbreak߰ߦcontinue߹߯if߿ߵelseƞ߼for̞doҞwhileٞswitchcasedefaultenumhexcode_IF_IdaC^ ^ b^ |^ d^ ^ ^^T^ ^2^I_Ҟ_Jae2 _J_DX_ _ _ _D1P hc@` c@n[ejc@Lc@` c@`;e3_ L/g *` J c@%`  _8UNSATISFIED GOTO e   aaץg Η_ _6_z8azo` z.azowĽa zaz aoaz` zn z%azoz&_{x_ ^oz&Lz%0P_{xazaz_s_|azazaz aaza_>az_sa a3%iz,Mz,_؞ hz+_f_8 SELF REF !`;b  _8ILLEGAL FUNC DECL 4!8Y0 03`;b0  PSRS";߱ac2ݜTcBFa e0  ac2ݹTcFUac2ac4{ VcF]cF_DlD_D_Dl    }az0 az0 ǡ8YazЎazБazazU8Й򡃡Ӏ_Du_D_Db_ _D_Db_ _ _Daz0 "azaz_lƽ _Jaz0 ХЦ4 ,_  ߞ"ީ _Ѻ1_}C+=_>J-=_7Q*=_0X/=_)_%=_"f>>=_m<<=_t&=_ {^=_Ђ|=__d_eЀ_:#;U{ g J ` c Lc@` c@n[e`cac20   ֕n cf U  ac28  _gn cac2ac4ڡ1aeac2կoe!_g` c@Lc@"]c=_ 1<_7>__߇2_:D<<_K>>__ߖG_:[+_a-__ߥ\_:\q*_ w/_}%__߻x_:ڊae"֐_EMe4 ae43a3e$_hvke4MzMzMzMzo_IdH (_IdMzMzA__ ^o1a5oazv3a8zx _ ._ ^oK_DB_ _D_|_| f4P_{lazv3a8zxJaߩa_ {asҐas_sqaw_>wkzv(ZC:Ӽ_J2_~=_cJ3o9cZ0acJUoScnSacJUoSc8څ3  ь (icJ0acJUoScnacJ3o9cacJ3o9c^oXLcMcJkcJacJ03a3cZ!1 acJ3K1cnkcJ>acJ3a3c1  ;m  ߗuv8C]P _kn>azƗ8_k~/Pazؗ0О=i00     0Q00S0S8Y03 P_lơ9P_lƋ070XFHVӇѨ_DD_ _D_DR_меЭЦЕxgXѷ&߳_T++߼_ܞ--_-_֞~'_!/_  _8_Ğ++_--__E_I| (MzMzMz_E_Id (MzMzMz_ELz%Mz&_D_S_az&__` z%.{p_D_Fa c5 8`    Lz%aoz&~Ҽ_s_ Lz%o z&5aa_{x_*_|az0  0_ka z 0aaz_(8_lƽ Vz azoz&` zn z%_{x_|az0_kazaz5Tzaz_8Y0   0_(8a_lơ19b_ KK"0 _J_J4 VcB]cB_DIp_ _ _D6WLc4zߔMc0_ KK'` c3Ecoc` cn c  acRnLcMc2߻8ߧacJUaUcZu8_ KK$ _8 UNION INIT<>0QߖDԳԵaza zԠ_k  _K3 8azaɕ`z   r i_8 NOT LVAL _DS_Dae ae"Ւ1azazЮazazЄazazխ_|u+-*X_$'_{_{ ).'4(_x_{.0ӵ'5D)8߳_| _P_|6@U(K_:߃_Jc)Rg[ _}Q_n]b_t-> d_I2m_$p_{_҈. w_I2Ҁ_$҃_{_jӋ  _knz%Mz&5aaG_ Lz%Mz&azPU1 ع_R_8_eܡ9_ ^:0ؽLz%o z&!2|p {p s_D_ p {n z2]zozozoz_ ڞ0 0  az p!az s_ aa!5_ __F`   a0  ИC_F`   a0 0ЮC_Fa0  ` J_Fa0  0` ^_ aa R(a_a _MAGE HOJOB E=mainacJ3A0cacJ3a1c aacJ3o0cacJ3o0cacJUAScnacJUoScn5TcF]cF$,5TcBRcB8桃  ҦҬ!$_Q6``0Q(Z_ VcB]cB_DI_*/%{}<> [ ] =#&^|n z*` z*9_D_ `{_ ڞ_R ++ --ҡ ** // %% && || ^^ {{ }}ߙ<ՉӪՋaz0 az0 _k %% azLazP_kazUazXaҋ߮_y_ __ ҟү0 ҲxҵX_z_{*ү_z Ll_z'Ԗ'Ş"ԙ"Ξ,____yZ)_y_f_y*_e̞d )_eݿΊ f d  b _kP_l02N`z  Tz_JK@7+I Tz_Jaz_JgPpR5azԼaz_hv1  ߯L(  ߚU ߔrsj^  azzߡi߀wk  ܣdХaza z  HAVE BEEN PRINTED --- itions without pegs: ^YJ^Z^Z^Z^Z^[^\^\^e:^eD^d^e$^Ql^ed^e^e^e^LZLZLZo_I|_I|_EpC x  Ep \\3 x  E_Id_Id _IdD 00.}p 11_ B 22_ V 44_ L_89acJ3a3c !l _EacJ3a3c # _Ez_> _>7_ ^18"Q_00ac F _8TOO MANY STRINGS 3o5cġ3o0dPicž_DlD_zaz7_ԞҸsPFuazrazv_kaz{az~az {{ }}TazI7ӌsPsբazӞazӡ4ӣ4P֊azaz_l_E8YP_l06 _Jf𡃽 _Jr (9 ߺߴ߭ߧߖ{jL`N?4DKBEFKX:L>NULOP[?_Yg|_I__ERs^t^lPl_ERӀ&xVx_ERӌ==ӎ=ӆӔ!=Ӗ#ӎgm %c %c %c %c %c 4;/֩3/3 ?/3 ԪΕa2 ran out of free space -- abort 4Щ!va2YS&a25Po2b1/%b1 3%.last test shouldn't be nec. end R5:=R10; R3:=R10+AREFENTSZ if R1:=AREFPTR-R3 <>zero then LDIRB @R5,@R3,R1 ...adjust AREFTAB AREFPTR:-AREFENTSZ end restore R6..R13 RET ...machine dep: RDMEM: PROC ...enter RR2=addr; R5=size (1,2,4) ...reprintit \newmnode getnbr instate jinit listpath $dejavu win&main --- mnspace2mnavail4stateTcountVhistoryVpathppathlastcharhposprtӏ_ERӥ<=ӧ[ӟӭ>=ӯ]ӧ ӵ<Ӹ>ӳӸӱЄӲ_ER<<{Ӿ>>}Г_ER+-Н_ER*/%_ER-n ~! _ т(b5 7$bΕ36` 3  3=x203 003 9 03  3&ҏ203 003 9c 0U0S6ҩ20n cΕ! enter initial configuration as list of positions wit. RR2=data at addr (sign extended); data read host machine order case R5: of 4: begin RDR1aRR2(); R1:->R0; RDR1aRR2(R3:+2) end 2: begin RDR1aRR2(); EXTS RR0 end else begin RDaRR2(); RL0:->RL1; EXTSB R1; EXTS RR0 end end LDL RR2,RR0; RET WRADR&65&4 (b;5P[3^b$PF +3: % /ݠ^䡳 ^ꡳ5P[b$PF +3:333 Abb0&⡳0;34763b1S&1S; ^)M_e:_eDԷ_e@%&(ޘ-_eT_eP_eL_eT_efE9_ebL G_ef߾@_e~>_e%_ej$h5_ez 3_evd_eb_er{sKԁy_enrthout pegs: 4w16c c5PVv4eUSQ/%?oTО63c aT5PoTv4eUSU/%Ε!+o217s [s07vuYSD$36c Bc064u SeUS!#_C: PROC ...RR2=code addr to write @RR4 PUSHL RR4 WRDATA(R1:=SZPOINT) POPL RR2 XLCDADR() INRELOC(R5:=0) RET WRADR_D: PROC ...RR2=data (bss) addr to write @RR4 PUSHL RR4 WRDATA(R1:=SZPOINT) POPL RR2 XLCDADR() INRELOC(R5:=1) RET WRDATA: PROC b +3 .'b$PF5P[ ^b⡳347j31S;b1S& ^ꡳ5P[b$PF +3::3c83!3!#"71(!3"73(!#*71(4751357l3N"_e_en.ޞԗV_ey_ev_eԨ_I2 _idԻԹ_iԴԼ_i{ _jF_j}ΞЊמ,;߻ _f_k_j_k6:_j, ;83+4ơ SeUS!#93vuYS/塅3vqD7h$$訠!Xn ܃3o36c c06vVeSU.-Ε16caS5c06c  =/ک%d->%d 4 ...WRMEM with data put in target machine order ... WRMEM: PROC ...enter with RR2=data, RR4=address, R1=size (1,2,4) ...store data at addr (host machine order) save R6..R8 LDL RR6,RR2; LDL RR2,RR4; R8:=R1 if R8=4 then begin WRR1aRR2(R1:=R6); R3:+2 end7𔂩3(53>137𔂩1(5$P7./ކ`% o暠 x晠 u映 X朠 D曠 d枠 s c13 11S1311S15P3! /Ϡ15P335$P7 +3_mv &,-;!_t_f'<*2_e̞_I2?D=_e M(C>S)GEZ(I^)R_e_eZo[Z_Ev]jՕh_I2lՁ{uwrՇ,}Վ}Ղ_ef_I2 ՏՔՍՆ՛=vVeS!#3vVeS1#3քΠ=/Ε36?8  5PXc3v4!EUQSUS5S61eJE37c*6vVeS +u3S31 vVeS$ MqU.-3Ε if R8>=2 then WRR1aRR2(R1:=R7) else WRaRR2(RL0:=RL7) restore R6..R8 RET RDW: PROC ...read word from @RR2->R3 (host machine order) RDMEM(R5:=2); RET WRW: PROC ...write R3->@RR4 (host machine order) WRMEM(R1:=2); RET MOVDATA: PROC ...move @RR2'->@/^$Ε5(571  5$PH!-.-5D$B74&b51 BB O @@0.-1  b +3 9b$ MUV.-b$PF51 DB"O 1@7$sp, R5=^symtab entry of ... "dec sp" label ...if FIXAREFS done since "s", put out full size "dec sp", else ... look at AREFTAB: if last item...before "C" (if "C") ... ='l' of "dec sp" then see if can shorten "dec sp" (incl. shifting ... code down ...&Տ҆Ց_i Ցզ,՜խ;ա|_xդչ=Քկ_Ҟ{_w2Ѣ_`_wD}Þտ(ռ)͞_y#7_ :__R__4__N/_$_X_R_h__DQ__N7 _X9 18 ^ z5PXv4US!# ^tvYS"&b(^tb5"&v4d1EUS!# ^nv4d!EUS!# {v4d1EUSv4/A/!v4d!EUSQ/%Dž3v4d1EUSv4/A/!RR4' R1 times ...host machine dep. save R6,R7 if R1<>0 then LDIRB_(LDL RR6,RR4) ...later LDIR restore R6,R7 RET ...machine dep: GETJPSZ: PROC ...enter with RR4=addr of jp (after basic JP inst, before addr), ... RR2=target addr; ret. R3=(total) sizPHdPF M.-b4B5SΕ5&38b$PF +3 08 Ε5&331 83b +3 - 1 5P3 b$PF13393%5PXb$PF +23 003 9  0U0S9 fixing "C"); ...in any case, put out "dec sp" & remove "l" from AREFTAB save R6..R13 LDL RR8,RR2; R11:=R5 UXLCDADR(LDL RR2,R11[ADRHI]); LDL RR6,RR2 ...RR6=location of "dec sp" if BIT CGFLG[R11],UNFIXB zero then begin ...if FIXAREF done bet. "s" &VM__z&;_Dq=_1(%"7;+_N!_,A;5__R4I)__R_N_R> _h_R_H])QRЀT_X_h__D֞_Оc_p_Еi_l__P_D֫ kv_sֈ:|Ъ~ֱ_ ~֓:ևе։_lv4d!EUSU/%AaT5PoTa5PovVaSd1E3%vVaSd!E3%vVaS/%aT 1Z^ ^8^ a 3Iv4vVa1EUSv4vVa!!/A/!v4e of JP inst needed ...may call XLCDADR save R8,R9 LDL RR8,RR2 XLCDADR(LDL RR2,RR4) ...RR2=cur. addr translated to target machine R1:=R9-R3 R3:=SZBASJP+SZPOINT if R8=R2 then begin if R1=SZPOINT then R3:=0 else if R0:=R1&0FF00 zero or R0=0FF00ޠ51URSS5/%1 SΕ1EΕv&18 0d!B8 33!33o103baQoS +3Ε5P@7c3sΕ5P@ now PUTDECSP(LDL RR2,RR8; LDL RR4,RR6; R1:=SZDECSP) end else begin R10:=AREFPTR-AREFENTSZ ... if B.@R10[AREFCD]='C' then R10:-AREFENTSZ if B.@R10[AREFCD]='l' and begin LDL RR2,@R10; R3:+CGTABBSE==R11 end then begin GETDECSPSZ(LDL RR2,R։֞;֒_֧֒;֛ ֒_ֲ֝;֦_h1֦_I2ִֶֻ֯_x_ֱ;ָֺ{_r_r_r}͞_ _x:ܞ;;_e6ג_eDҩׁ_eLұב_e@Ҵ_eH_j_mvVa1EUSU/%a5PoaT5PoT^ ΕaaT ,V43Z --- ALL SOLUTIONS HAVE BEEN PRINTED --- 4_ΠΕ0Xf<.j| then R3:=2 end restore R8,R9 RET GETCALLSZ: PROC ...same as GETJPSZ except for CALL ...may call XLCDADR save R8,R9 LDL RR8,RR2 XLCDADR(LDL RR2,RR4) ...RR2=cur. addr translated to target machine R1:=R9-R3 R3:=SZBASCALL+SZPOINT if R8=R2 then beg7c3sΕ1A7c3sΕ15 1B7c3^sΕ15 1C7c3.sΕ0 5 1(c3ΕR8)->R12 PUTDECSP(LDL RR2,RR8; LDL RR4,RR6; R1:=R12) if R13:=SZDECSP-R12 >zero then begin R1:=R12; R0:=0 LDL RR2,RR6; ADDL RR2,#SZDECSP; LDL RR4,RR6; ADDL RR4,RR0 LDL RR0,CDPTR; SUBL RR0,RR2 MOVDATA() ...move code dow_S ߹$,+;/;_\_f%_I25:3_e.C( _bߓJ)>_eS*I_e̞[(&QLa)U 1Vk=_m|c_m_n,_n؞_nׂ{ _nXz_nt׋}Ի_sׂח,n h        & < F L z    F P p    T   2H^d~in if R0:=R1&0F000 zero or R0=0F000 then R3:=2 end restore R8,R9 RET GETDADRSZ: PROC ...enter RR2=data addr; ret. R3=size of addr ref R3:=SZPOINT; RET GETCADRSZ: PROC ...enter with RR4=addr of code addr ref; RR2=target addr ...may call XLCDADR               v41US!#3!*!-Ε %c 41/.3 n R12:=0 ...RR12=am't to adjust code ... if R1:=AREFPTR-AREFENTSZ<>R10 then begin ...if have 'C' ... LDL RR2,@R1; SUBL RR2,RR12; LDL @R1,RR2 ...fix ^mem ... B.'C'->@R1[AREFCD] ... end LDL RR2,CDPTR; SUBL RR2,RR12; LDL CDPTR,Rԇס&א_I2י_Tל_I2_vף__tLצ׻,ױׯ_I2׿׽_tR_v|_u_v___e:מ__ePӚ_eTәB!g5d]߻L<*0DJZjpv|.printflengthputcharDatoicnvt"getchar ...ret. R3=size of addr needed save R8 R8:=R2 XLCDADR(LDL RR2,RR4) ...->RR2 R3:=SZPOINT if R2=R8 then R3:=2 restore R8 RET GETDECSPSZ: PROC ...enter with RR2=am't to dec sp ...ret. R3=size of "dec sp" needed LDL RR0,RR2 R3:=0 TESTL RR0; RET Z %c %c 42/L33/S3   %c %c %c 44/r35/y36/Ѐ38  %c %c %c %c 47/Р38/Ч39/Ю3:/е3 R2 ...adjust CDPTR end end else begin PUTDECSP(LDL RR2,RR8; LDL RR4,RR6; R1:=SZDECSP) repeat R10:-AREFENTSZ ...find 'l' of "dec sp" until B.@R10[AREFCD]='l' and begin LDL RR2,@R10; R3:+CGTABBSE==R11 end or R10=^AREFTAB; ..errnoopencreatclosereadHwritexseekconnectmovemnspace2mnavail4stateTcountVhistoryVpathppathlastcharhposprt:  R3:=SZDECSP if CPL RR0,#16 <=zero then R3:=2 RET GETENTRSZ: PROC ...enter with RR2=packed am't of local storage+no. regs to ... save when enter func.; ret. R3=size needed for inst. sequence ...seq. is: PUSH FP; FP:=SP; DEC SP,n; LDM @SP,R8,m R1:=4., RR4=addr ...put out ret. from func. inst. sequence save R8,R9 LDL RR8,RR4 if R2<>0 then begin R1:=R2 R2:=01C01|(SP*010) R3:=(FSTRV_A*0100)|(R1:-1) WRMEM(R1:=4) R9:+4 end LDL RR2,#09400|(FP*010+SP),09500|(SP*010+FP) WRMEM(LDL RR4,RR 5 $U3c % 5B c 09 }Н<3Ȁ  c % Ž@B5Bc}c}'c}+A5 @B7 5B75 T%'13 ý %6` 11S06'`3:=2 else if R3=05E00 then R3:=1 else R3:=0 RET PUTCDADR0: PROC ...enter with RR2=code addr to ref, RR4=(code) addr to put at, ... R1=size to make; may call XLCDADR ...chk for call or jp inst in prev. word & maybe do PUTCALL or PUTJP save R7..R11 PIP B:=A:C.M PIP B:=A:CDATA PIP B:=A:CBAS PIP B:=A:CSUB PIP B:=A:MACDEFS PIP B:=A:XSUB PIP B:=A:CGSUB PIP B:=A:CGPUTS PIP B:=A:CODEGEN PIP B:=A:XXC PIP B:=A:CBUG  o here^ PIP A:=B:PREPROS PIP A:=B:CDECL PIP A:=B:CX PIP A:=B:CMAIN PIP A:=B:HOJOB.M PIP A:= if R2<>0 then R1:+4 if R3:+R2*2<>0 then begin R1:+2 if R3>16 then R1:+2 end R3:=R1; RET GETEXITSZ: PROC ...enter with RR2=packed am't of local storage+no. regs to ...save when enter func. ...ret. R3=size needed for ret. from func. seq. R3:=8; R1:=4); R9:+4 ...SP:=FP; POP FP WRW(R3:=09E08; LDL RR4,RR8) ...RET restore R8,R9 RET ...************* ADDXRELO: ...enter with R3=snum, R5=symtab ordinal ...add undefined refs. to symbol to reloc. table (say if init'n ref/ ... code ref) save R7^Ȁ###0#%##%Ȁ%Ȁ4 :7 '"Dj!!!""(">"R"f""$$#:&(*R+1?  "a"J3!-{Д$1 ?1Ա Ը0 !{B1 _1СLDL RR10,RR2; LDL RR8,RR4; R7:=R1 LDL RR2,RR8; R3:-2 R3:=RDW() CKCALJP(R3)->R0 ...R0=2 if CALL, 1 if JP, 0 if LD LDL RR2,RR10; LDL RR4,RR8; R1:=R7 ...args for below if R0=2 then PUTCALL(R1:+SZBASCALL) else if R0=1 then PUTJP(R1:+SZBASJP) else PUTC PIP B:=A:RJ.X$$ PIP B:=A:RJ.S$$6 ...SP:=FP; POP FP; RET if R2<>0 then R3:+4 ...LDM RET PACKEINFO: PROC ...enter with RR2=am't of local storage, RH5=no. A-type regs ...to save, RL5=no. B-type regs; ret. RR2=all this packed RL2:=RH5; RH2:=0; RET ADDDISP: PROC ...add disp. RR4 to..R11 R7:=R5 R3:=CGLKUP(R3) if BIT CGFLG[R3],CHAINB not zero then begin LDL RR8,R3[ADRHI] SET R7,15 ...bit 15 of relotab entry=1 =>external repeat RDMEM(LDL RR2,RR8; R5:=SZPOINT); LDL RR10,RR2 R5:=R7 if BIT R10,ADRFLGB not zero    !{!2!{ }63 5.75*7{5! 00,$w4n P %%/q  BB߭ CC.kp WW߻ SS!u߱ FF2q ߱.hp DADR() restore R7..R11 RET XLLDOP: ...enter R3=base load (addr) op; xlate to corres. op for rel. load case RH3: of 060: RH3:=030 061: RH3:=031 054: RH3:=035 06E: RH3:=032 06F: RH3:=033 05D: RH3:=037 else RH3:=034 ...07600 (LDA) e PIP B:=A:ZED3$$PIP B:=A:ZED22$ addr RR2 R3:+R5; RET PUTNOOP: PROC ...put out R3 bytes of NOOP @RR4 (actually LDB RH0,RH0) save R8..R10 R10:=R3; LDL RR8,RR4 while R10>>0 do begin WRW(R3:=0A000; LDL RR4,RR8); R9:+2; R10:-2 end restore R8..R10 RET PUTJP: PROC ...enter with RRPIP B:=A:EE PIP B:=A:EE.M PIP B:=A:ZED1 PIP B:=A:ZED2 PIP B:=A:ZED22 PIP B:=A:ZED3 PIP B:=A:RJ.S PIP B:=A:RJ.X PIP B:=A:EEX.M PIP B:=A:HIST  \\  NN  TT .hp.hp 4ġq1t}> {8ಁ00 99.hp (0PP!`P !`W5p w @qp  !b paq*;nd RET PUTCDADR: PROC ...enter with RR2=code addr to ref, RR4=(code) addr to put at, ... R1=size to make; may call XLCDADR save R6..R10 LDL RR6,RR2; LDL RR8,RR4; R10:=R1 R3:=GETCADRSZ() if R3=2 then begin ...can do LDR/LDAR R9:-2; LDL RR2,RR8  PIP B:=A:ZED2$$ PIP B:=A:ZED1$$2=addr of target, RR4=addr to put JP inst ... (actually after basic inst already in memory), R1=size of JP inst ...may call XLCDADR save R6..R10 LDL RR6,RR2; LDL RR8,RR4; R10:=R1 R3:=GETJPSZ() if R3=(SZBASJP+SZPOINT) then WRADR_C(LDL RR2,RR6; LDL RR878 88&848B8P8^4.x!p4.nT $G7B]4/!0:870L8CON4-4!@B_5 潒baL8L8!o8r!! %UU !UU % !/!a` ^B!v  0b/* L$`(! `dO(qwhcvyps3c27p߲]Tic桢qT@x]w  RDW(R3)->R3 XLLDOP(R3)->R3 ...R3=corres. rel. load op for load op R3 WRW(R3; LDL RR4,RR8) R9:+2 XLCDADR(LDL RR2,RR8; R3:+2); R1:=R3 WRW(R3:=R7-R1; LDL RR4,RR8) R9:+2 PUTNOOP(R3:=R10-2; LDL RR4,RR8) end else WRADR_C(LDL RR2,RR6; LDL PIP B:=A:EE.M$$ PIP B:=A:EE$$$,RR4) else begin ...JR XLCDADR(LDL RR2,RR8) R7:=(R7-R3)/2 ...offset R9:-2 RDW(LDL RR2,RR8)->R3 ...read JP inst to get cc RH3:=RL3|0E0; RL3:=RL7 ...set up JR WRW(R3; LDL RR4,RR8) R9:+2 PUTNOOP(R3:=R10-2; LDL RR4,RR8) end resto:   !7.X3.XC: ::::13L8g7Q7^4Xf8~b8~{

[]e^e]Wr*)]e][]e]N#[]́]͘]e]>0{S+][)]S)][+]ͯyo]*+]w#"+]o]og}(%#o]oo]gXxe] ~ N#y( >+>0y${[]ɯ2.]e]>!8{!( (,(( GH L( []:.]=> R1==0; RET Z if R1=2 then begin R0:=R3-1 WRW(0ABF0|R0) ...DEC R15,n end else begin WRMEM(R2:=030F; R1:=SZDECSP) ...SUB R15,#n end RET PUTENTR: PROC ...enter with RR2=packed am't of local storage+no. regs to ... save when enter func., RR4      ^  @@0ʗ ߾ f  ݯh8"d&Ȁ&0   0 &2$.&Ȁ-&$begin ...JR ... LDL RR8,RR4; R9:-2 ... R7:=R3 ... XLCDADR(LDL RR2,RR4) ... R7:=(R7-R3)/2 ...offset ... RDW(LDL RR2,RR8)->R3 ...read JP inst to get cc ... RH3:=RL3|0E0; RL3:=RL7 ...set up JR ... WRW(R3; LDL RR4,RR8) ... end ... restore R7.03$j8&2$#j8:ȃ:!1!:B !<$G<%<-<#<+5+1+7+3+!!1!: @a8U%"4NL8 -]_` L8> AȆ>H>M:"@M85+7+1** O9* 9(  9G 9]-0D9]+0e]${[]o] `o]v  _@o] 9]LD B_/],`o] _o] co] a o] Ϳeo] o] 9]JR ( 9]DJNZ G]o] 9]=addr, R1=size; put out inst. sequence save R8..R12 LDL RR8,RR2; LDL RR10,RR4; R12:=R11+R1 LDL RR2,#09100|(SP*010+FP),09400|(SP*010+FP) WRMEM(R1:=4); R11:+4 ...PUSH FP; FP:=SP if TESTL RR8 not zero then begin LDL RR4,RR10 if R0:=R8*2+R9<=16 the5BB303%%5 5BɞB5%1% $\5 %0Сc}߽)!c % 5 $P5 @B7 c1S9 05 `Ȁ.R9 ... RET PUTCALL: PROC ...same as PUTJP except for CALL save R6..R10 LDL RR6,RR2; LDL RR8,RR4; R10:=R1 R3:=GETCALLSZ() if R3=(SZBASCALL+SZPOINT) then WRADR_C(LDL RR2,RR6; LDL RR8,RR4) else begin ...CALR XLCDADR(LDL RR2,RR8) R3:=(R3-R7)/2 &0Q:JL8L8 1+!.(K83+L80 8!8wL8< 4 B:@_`TR7 …U7)d 7)\ 4)\  ߲Ȁ($ O  p EX AF,AF'9]DEFB 0?^o] ͔ao] 9]DEC (9]INC  o] ͂_o] o_o] /]C/]Bo] /]E/]Do] ͢_o] /]L/]Ho] /]A9](HL)o] /]E/]Do] _o] /]L/]Ho] /]A9](Hn begin R0:-1 WRW(0ABF0|R0) ...DEC R15,n R11:+2 end else begin WRMEM(R2:=030F; R3:=R0; R1:=4) ...SUB R15,#n R11:+4 end if R8<>0 then begin R2:=01C09|(SP*010) R3:=(FSTRV_A*0100)|(R8:-1) WRMEM(LDL RR4,RR10; PIP B:=A:PREPROS PIP B:=A:CDECL PIP B:=A:CX PIP B:=A:CMAIN PIP B:=A:HOJOB.M PIP B:=A:PRINTF.C PIP B:=A:BASICIO.C PIP B:=A:HOJOB.C PIP B:=A:YLINK  PIP A:=B:HOJOB.FFF|0D000 R9:-2 WRW(R3; LDL RR4,RR8) R9:+2 PUTNOOP(R3:=R10-2; LDL RR4,RR8) end restore R6..R10 RET ...PUTCALL: PROC ...same as PUTJP except for CALL ... save R7..R9 ... if R1=(SZBASCALL+SZPOINT) then WRADR_C() ... else begin ...CALR ... p  OAȀ  H  4*Y! H.(0P4*<.I驓 I PNE4(xp 7CU5)a8x5'  B!B>S T4   K8r!L)@o]  e͉` o] _o] ͹_o] /]C/]B o] o]  _( 9]EX DE,HLo] 9]IN A,(ͱa/])f  ͊:_͊!J$=(xͬ͊0xͬ! >xͬ! ͊>O͊0#͊!!R1:=4) ...LDM @SP,FSTRV_A,n R11:+4 end end PUTNOOP(R3:=R12-R11; LDL RR4,RR10) ...if need to pad (because FIXAREFS done) restore R8..R12 RET PUTEXIT: PROC ...enter with RR2=packed am't of local storage+no. regs to ... save when enter func64{' 7 2c %333 :(CґҘ :(5 Ҝ''Ɋ'05 11@E ԃ%h8'%ᢗᦗ'ȀӊщО5 ‘%1% $P5 %6Е!  c %LDL RR8,RR4; R9:-2 ... R7:=R3 ... XLCDADR(LDL RR2,RR4) ... R3:=(R3-R7)/2 &0FFF|0D000 ... WRW(R3; LDL RR4,RR8) ... end ... restore R7..R9 ... RET CKCALJP: ...enter with R3=base of inst.; ret. R3=1 if JP, 2 if CALL, else 0 if R3:&0FF00=05F00 then R7)p5o8x5)b7)d1)^opFg`upF5)>ݞFp6eFfc0cpFc g6SuFeQ!Gg/G5S3B3ݾ5(H5SFYyw0&7Yi0&)cF\ 85BS77(13(K; w#w#w(>V#N#~$#~+: ~@##>c~. #>c>u >Gx( ~́ #x (@8Z80(.`8}8&($/898(!8)8(+( -(\(^ xͬ((#͊!!OW_}T]Oů)lau!t"w#1* O9* 9(  9Gwk~kBinfF n:_n!J$=(x͐n0x͐ >x͐ n>On0#n!!w#w#w(>V#N#~ JR LUP LUPX~ if R10<>0 or R11<>0 then begin DIFSIZ~ ?"Files are of different size" end else if DIFFLG=0 then ?"Files are identical" CMPCLS~ close(R8); close(R9) CMPX~ restore R6..R11 RET OPEN: ...open file with name @R3; ret. R3=LU; print msg if errF GWRONG FILE TYPE\n F G%B???\nF G???\na- .. /093 00 99 AA FF aa ff  AAߴys!>^!x!Bء8 !  M>^sXsDL8>a8¡]4_`M8a8…U AȆ>H>M4:"@M8žW*w@L8=L84a8i  .`   .` po8…L8 L8i3Q@iL8s}a8K84x( >!O  ̀4x( >"O  ̀SH)lgxͬ!!G͊H͊ 4 # (  >>KHB~0 #~/ >:w>A+w͐( >Ƿ ͐(>>;Ϳ~I #~ ( ͜~# (X$#~+: ~@##>G~. #>G>Y >Gx( ~e #x (@8Z80(.`8}8&($/898(!8)8(+( -(\(^ x͐((#n!!OW_}T]Oů)lau!t"w#x( >!3  dor save R6,R7 R6:=R3 if R3:=open(R3,0,->RL5)=-1 then begin RL7:=RL5 PRTSTR(R6) if RL7=0C7 then ?" NOT FOUND" else ?": OPEN ERROR ",RL5 R3:=-1; RL5:=RL7 end restore R6,R7 RET READ: ...read LU R3 to buffer R5; print msg. if err; ret. R3lus set high bit\nF GB if order is to be XY (column first, then row) rather than YX\nF G (row first, then column):\nF GF Example: 'A0' means if the 2 chars. sent are '20' then '21', the\nF G< column will be set to 0 & ! (o8ȀЏ  qȀ &/ .k !.kҡ=Ȁ  L8_`Ȁ M8ȀM8L8L8!8o8o8(<=]]J -& ˡ ߩ(>3>3*.>Z##{:(+:!b ͏  S D  ͫ :(( :3   & ́ b͕͠L ɯ!w#4#(!4#(͙ ͦ !͙ Gͦ x+| !@́ (+| >Gͦ xZ8000 SYS NOT READY 2222!x( >"3  dSH)lgx͐!!GnHn 4 # (  >>KHB`!PO>(G (+| |ʣ>}aiaiQY{Gz(<= B0 KB! DM#| >>2=len read save R6,R7 R6:=R3 if R3:=read(R3,R5,BUFSIZ,->RL5)=-1 then begin RL7:=RL5 PRTSTR(R6) ?": READ ERROR ",RL7 R3:=-1; RL5:=RL7 end restore R6,R7 RET PRTSTR: ...print string @R3 until 0 save R8 R8:=R3 while RL3:=@R8<>0 do begin pu the row will be set to 1\nF G [A0]\nӻn F G\nF G9Do you want to change any key functions? (enter Y or N)\nF G DEF G\n YY^ d a!1pF GDThe following cursor movement keys (as well as the DE ֊n  . ա      ި      ^  @@0ɗ ߾ f  ݯKhw#!"">2!w#ͩ ͨ(͙ >ͳ ͮ  ! !6b͙ 2O: Ͳ y ͼ ((   (>>2 ?R 2222`h"`h"22`h"`h"ͩ ɷ <8>G>(?2W B>^w#>w#zw#>w#xw#yw#zbk`iG | ! T]xoyG>O!P>y +| ʣy>g( ͣ:gͣSYS: Z8000 NOT READY FOR BOOT !ͮ{y~͸#~ (>syhS͸K{[q:s!!c:(tchar(RL3); R8:+1 end restore R8 RET CMPBUFS: ...compare data in BUFF1 and BUFF2; if different, print differences ...R3=len to do; RR4=starting file offset save R6..R11 R8:=R3; LDL RR10,RR4 R6:=^BUFF1; R7:=^BUFF2 while R8<>0 and ABORTFLG=0 do beginLete key used\nF G-in INSERT or REPLACE modes) may be changed:\nF G '4' (cursor left)\nF G '6' (cursor right)\nF G '8' (cursor up)\nF G '2' (cursor down)\nF G% '7' (cursor to top left corner)\nF G( 8"Ѩ&Ȁ&0  S 0 &2$.&Ȁq&$5BB303%%5 5BɞB5%1% $\5 %0С~ #= (ͩ > >2CAN'T DO CMD !=(!$ *m :G: ͥͶ2Sy2  b *:G'A >&8~O# w!H [ "2O:G(2J !" `i:G;2(+> * *" *| >( SCREEN͸ !"c!"{K{[v:x*t!c*.>Z ## # ]++3 >\:(>\!+| !N#T] w ( S >2N 2 (>.~ (# ps/DO Csmm~O#!ͱ("bk"{c( ͢"͢'S' NOT FOUND  CPSIRB @R6,@R7,R8,NE if zero then begin if DIFFLG=0 then ?"File offset File 1: File 2:" DIFFLG:=1 R3:=R6-1-^BUFF1; R2:=0; ADDL RR2,RR10 if R2<>0 then printf("%w",R2:) else printf(" ") printf("%w ",R3) PRTBYT(B. '1' (cursor to bottom left corner)\nF G tab (cursor tab)\nF G '_' (cursor back-tab)\nF G\nF GDIn the following, enter the ascii value in hex of the key you want\nF G?to change to or 0 if no change is desired; end with...program to compare two files ...call with COMPARE FILE1 FILE2 ...hit CR or '?' to stop/start printing, ESC to abort BUFSIZ: EQU 02000 ...06000 ...need space for 2 buffers /SEG START: PROC LDL SAVSP,RR14; LDL RR14,#MYSP GETFNMS() ...get filenames b *|!oB !wNF^V~ͪ nf~ G[:Ox 0ͱ O:G(2@ `i:G(2(:*A `i:G2 *| b :G2 b G!=T]ͩ   *:"2*B 0DM!!";  'SCREEN' NOT FOUND ERROR  :! !)!????098(w#098(w!ͮGr͚z/IMAGE SYS.COM !{S >2N 2 (>.~ (# ps/DO Csmm~O#!ͱ("bk"{c( ͢"͢'S' NOT FOUND @R6[-1]) PRTBYT(B.@R7[-1]) printf("\n") TSTKEY() end end restore R6..R11 RET TSTKEY: ...if key CR,'?', stop until another ...if ESC pressed, set ABORTFLG and print abort msg. RL3:=GET1IF(); RET Z if RL3=0D or RL3='?' then begin  :\nF G@(the standard value for each case is shown in square brackets)\nF G\nF GC(Avoid changing to keys that have other functions; also note that\nF GEwith cursor movement keys, small letters (or any ascii values>=060)\nF from cmd line ->NAME1 & NAME2 R3:=flag; RES R3,15; R3->flag /NONSEG COMPARE() R3:=flag; SET R3,15; R3->flag /SEG LDL RR14,SAVSP RET GETFNMS: ...get 2 names from cmd line ->NAME1 & NAME2 ...RR12 pts. to cmd line GETNAM(LDAR RR2,NAME1_) GETNAM(LDAR *B 0DM[!!oR !!w"qp*:utw*ut:w!~(6ɯ2o >::*|}:: :*|} :*|}ͮ ] G: o >::[QYAaiͮ [:O "2ɹR*T 2O: i y { ( Ͳ >2 ͑? 2t2u2x2`h"v`h"y2~2}`h"{`h"` ɷ <8>G>(?2~ #- (` > >2CAN'T DO CMD !-~I #~ (  (!ͩrepeat getchar() until RL3=0D or RL3='?' or RL3=01B; end if RL3=01B then begin ABORTFLG:=1 ?"PROGRAM ABORTED" end RET GET1IF: ...get char. from keybd ->RL3 if ready; ret. Z=0 iff char. B.read(0,^INCHAR,0)==0; RET Z RL3:=INCHAR; RET PRTBYT: ..Gare equivalent to capital)\nF G '4' (cursor left) [34] ->\n՘n F G! '6' (cursor right) [36] ->\nղn F G '8' (cursor up) [38] ->\n˄n F G '2' (cursor down) [32] ->\n儻n F G. '7'RR2,NAME2_) RET GETNAM: ...enter with RR12 pointing to cmd line, RR2 place to put name ...get name (put 0 at end) & update RR12 while RL0:=@RR12=' ' or RL0=9 or RL0=',' do R13:+1 while RL0:=@RR12<>0D and RL0<>' ' and RL0<>9 and RL0<>',' do begin RL "*B":O! 6:O! 6ɯO! (wA<8x o >ͳ ͛ ͮ `iB8(́ >ͳ ͊ ͮ   DḾ Ͳ ͊ ͩ yx(ͳ ͛ `iB0 DM  B8 (   DMo >ͳ yx(=020 and RL3<07F then printf(" %c",RL3) else printf(" ") RET END: SAVSP: LONG 0 NAME1_: NAME1: DEFS 40 NAME2_: NAME2: DEFS 40 DEFS 0100 MYSP: B (cursor to top left corner) [37] ->\nn F G1 '1' (cursor to bottom left corner) [31] ->\n(n F G tab (cursor tab) [09] ->\nAn F G$ '_' (cursor back-tab) [5F] ->\n]n F G2 DEL (delete in INSE0:->@RR2'; R13:+1 end RL0:=0->@RR2 RET /NONSEG DIFFLG: WORD 0 INCHAR: BYTE 0 ABORTFLG: BYTE 0 COMPARE: PROC ...enter with filenames in NAME1 & NAME2 save R6..R11 if B.NAME1=0 or B.NAME2=0 then begin ?"MUST GIVE 2 FILENAMES" JR CMPX end R8:=ͮ =#B !͍*w "[*R~G> >Z  R ":!> Z O:o yͳ xͳ ͮ ͙  ͩ B(((ͩ ((Ͳ >ɯɯ>2@i#~: +~@##+x8( ~9j #x 2jx8(> >2@i~.  R U[D2NL8]ȁaciTyg75%7{ f''^ ^ ^6 ?^ >^ x11 '@ ; O6 $1  Ќ, 2' 3" в .  Г  ГUFF1: DEFS BUFSIZ BUFF2: DEFS BUFSIZ /MAP UNDEF /WRITE "/IMAGE COMPARE ",START," ",END," E=",START /SEG  at end) & update RRrintf(" %c",RL3) else printf(" ") RET END: SAVSP: LONG 0 NAME1_: NAME1: DEFS 40 NAME2_: NAME2: DEFS 40 DEFS 0100 MYSP: BRT/REPLACE mode) [7F] ->\nֱ n L ^F G>Do you want to write out new EE with changes? (enter Y or N)\nF G. (for now, writes out to EEE (rename to EE))\nF G DEF G\n YYf a;1pf a!1OPEN(^NAME1) R9:=OPEN(^NAME2) if R8=-1 or R9=-1 then JR CMPX DIFFLG:=0 ...CMPBUFS sets=1 if difference ABORTFLG:=0 SUBL RR6,RR6 ...RR6=current file pos. LUP~ R10:=READ(R8,^BUFF1); R11:=READ(R9,^BUFF2) if R10=0 or R11=0 then JR LUPX if R10=-1 PIP B:=A:C.M$$$ PIP B:=A:CBUG  o here^ PIP A:=B:PREPROS PIP A:=B:CDECL PIP A:=B:CX PIP A:=B:CMAIN PIP A:=B:HOJOB.M PIP A:=PIP B:=A:CDATA$$ PIP B:=A:CBUG  o here^ PIP A:=B:PREPROS PIP A:=B:CDECL PIP A:=B:CX PIP A:=B:CMAIN PIP A:=B:HOJOB.M PIP A:= Л Ё ŕ{ 1 1 {   ߨ Ѡ3a;!  &ˍCwa{! &554 $&  񃫽$l be set to 1" ?" HEX A0" B.Getnum()->POSOFF EC2: ? ?"Do you want to change any key functions? (enter Y or N)" printf(" "); getchar(); putchar(); ? if RL3&0DF<>'Y' then JP EC3 SETB FLAG,1 KEYVECP->R3; R7:=^CRSLT; R1:=LKEYVEC; LDIRh!vzqv~qV2.07. tdd disassemblerWrrdi {i Ói pj j j j" 7k 6 w * KDDDS $OeKKG]G;D DSKD(*** l:KK CLL3HfW""+L $O"  K or R11=-1 then JR CMPCLS LDL RR4,RR6 ...for CMPBUFS if R3:=R10<>R11 then begin if R3>R11 then R3:=R11 CMPBUFS(R3) ABORTFLG==0; JR NZ,CMPCLS JR DIFSIZ end CMPBUFS(R3) ABORTFLG==0; JR NZ,CMPCLS R10:=0; ADDL RR6,RR10 H !>Zo>o >h>֞] - ,, ޽o >8}} ]莞        ;;   .  󡕃5  ;,<>=* !! ~~ !.TEM>8ݣݼ F GFILE NOT FOUND\n  CJ Ϟ҈^$7 ꠱^" 5 5B7 ꠱{! Ľ1&0/C57B0qȂ>x>q>y>r>z>s>{>v>~>t>|>u>}>v>~ĕb8~L8~?b8< ]}2?}:}2?}:T4z4     ,,     ,,.(0.(` ` ʄF GMUST GIVE 2 FILENAMES\nk!ߔ8!ߘ9  \MrLuf!z:U %%4q  BBߨ% CC.kp WW߶ SS!u߬ DDߣ FF2q ߌ.hp \\  NN  TT .hp.hp 4Nq1ս}> {8ಁ00 99.hp (0PPA7!>p!Aa ҋ!hs@5j af! >a3 5aa7̡6"0! JC']>]>a<_Cf}} $00(   % 0}} ]>!5   ;; << >>*B":O! 6:O! 6ɯO! (wA<8x m >ͩ ͙ ͤ `iB8( >ͩ ͈ ͤ   DM ͨ ͈ ͟ yx(ͩ ͙ `iB0 DM  B8 (   DMm >ͩ yx(P>T>ߜj>a >}} H?!  / $$" 11 99 0K? 3a5>!U HPk.hp.hp .kͤ =#B !͍*w "[*R~G> >X  R ":!> X O:m yͩ xͩ ͤ ͓  ͟ @( (͟ (ͨ >ɯɯ$#~+: ~@##>t~. #>t> u >Gx( ~T#`#a# f#d!9f# q d!&`#Ԟ{Ԣ{@!] #n#o#  pԾT #`#a#w  !Ҟ{ X !h] #ؠ n #so#T #`#!Zy!!6! !B ߡcF G: READ ERROR %B\n!8 E8J!!$OLuLvnHMrF G"File offset File 1: File 2:\nMrc0 "F G%wF G F G%w `k߿`{`(! `dO(qwhcvyps3c27p߲]^TZic桢qT^@x]w   * wB1/p.k}} ]>! ? !  ! @- 90100-(00 99...800 99. !@ {p  먐    #MZ DMZaZ 8iZ ``13 857 2\  AD@!@}Ѐ~ BREAK AT TAdzZ` -  GG JJ DD߷ RR SS PP!@!P9?`!@^aAd  RR  HH]Ad}} aA`}!5U 1 1&70P!P!@ 0 26c+7"aCs!YcACcaq!BؓcA W !duuaK!zCs ް !! !`B"C8!ͽQ#`#a#,ՠՂ{\U!] #n#o#o#wq] #o#n#EJ!3] #o#n#T #a#`#蔢qIcߜ!u] #o#n#T#a#`#f] #o#n#T #a#`#T#a#`#֤>" if B.Getnum2()<>0 then RL3->CRSHM ?" '1' (cursor to bottom left corner) HEX 31 ->" if B.Getnum2()<>0 then RL3->CRSBTL ?" tab (cursor tab) HEX 09 ->" if B.Getnum2()<>0 then RL3->CRSTAB ?" '_' (cursor back-tab) HEX 5F ->" if B.Getnum2()Ёx!TP!  qr9諀  詀*" * p 00 99  ~w;P!  qr{諀 M詀  PX詀 vg  \A@yA`A@-͑1 ,,0& . .|.s   .. |.* }bғC5X bA}R_}Z (}R_}Z.(0_}ZX2 c- A!@ء9 s1!C֡sۡA h >1!AP.80 .80.80a!AQ8 Q0!ͽP!@ m8ԡ9"! !ν!Bء1 > MaСe!B *`'"DT#a#`#xa# L(!֘ Zy!֣ k~e!֮a#YsS7{QB] #o#n#*]#o#n#ӹ]#wT #a#`#ѴT#a#`#c\# @!oT#T #<>0 then RL3->CRSBTB ?" DEL (delete in INSERT/REPLACE mode) HEX 7F ->" if B.Getnum()&07F<>0 then RL3->RUBOUT EC3: if FLAG=0 then JP EC4 ?"Do you want to write out new EE with changes? (enter Y or N)" ?" (for now, writes out to EEE (rename to EE<   E++ E--P E..P *ު EEEP  E--P E++P E  00.IPn00.FP APbSE{m^P{xi[{уtf{юѠ{!ͽQ!@ء9 s1!C֡sۡA h >1!AP.80 .80.80a!AQ8 Q0!ͽP!@ m8ԡ9"! !ν!Bء1 > MaСe!B *`'"c}߽)!c % 5 $P5 @B7 c1S9 05 `Ȁɞ0P!@!@ ߩ%l0|6ފވ '0a1111011'11Ȁ!}a#`#O$@P]#] #o#n#锢q @!] #o#n#M# T#M]#(k#$] #o#n#锢qIT#M]# T#a#`#\k#k#M#-:JL>}2?}:a >J))" printf(" "); getchar(); putchar(); ? if RL3&0DF='Y' then begin if BITB FLAG,0 not zero then begin R7:=SCRVECP; R3:=^POSOFF; R1:=LSCRVEC; LDIRB @R7,@R3,R1 end if BITB FLAG,1 not zero then begin R7:=KEYVECP; R3:=^CRSLT; R1:*l{{ѣh{ѭя{ 1 (  0 !4ȅ!@ H4$уѼ{ 1 (0.HP{4|4vQ|...program to configure EE screen editor (Z8000) for different terminals FNFERR: EQU 0C7 ...error code for file not found HDRSZ: EQU 018 ...header size IMGSZ: EQU 2 ...offset into header of image size SEGTBSZ: EQU 0A ...offset into header of segment t4!4'閭 213033'Ȁ''ɗ51@E B1@E B5364ҿ'6 7 2c %333 ::CՕ ::5 & ''Ɋ'05 11@E %h8'!L>` -!?!l^M>Jߐ l ;;   // //[ ## ߡߓj8!   XXT - **K*  II o >JH !>Zo? o >h>] - ,, ޽o >J}} =LKEYVEC; LDIRB @R7,@R3,R1 end SAVE("EEE") end EC4: RET END: BUFF: DEFS 02000 DEFS 0100 MYSP: /MAP UNDEF /WRITE "/IMAGE EECONFIG ",BEG," ",END," E=",START  ->flag /SEG LDRL RR14,SAVSP; RET /NONSEG LOAD: PROC ...load in filename @R3 ("E!҄mo# q @!Ҙ] #n#o#qҢ] #n#o#G!T#`#a#ҼC!] #n#o#T #`#a#dm'!j6T!T#`#a#a#   qT #`able size SCRVCP: EQU 8 ...offset in EE of ptr. to SCRVEC KEYVCP: EQU 0A ...offset in EE of ptr. to KEYVEC LSCRVEC: EQU 6 LKEYVEC: EQU 9 BEG: SAVSP: LONG 0 SCRVECP: WORD 0 ...points to screen vector KEYVECP: WORD 0 ...points to key vector EESIZ: WORD%ᢗ(ᦗ'ȀщО5 ‘%1% $P5 %6Е!  c % 5 $U3c % 5B c 09 }Н<3Ȁ  c % Ž@B5Bc}c}'c}+A5 @]莞        ;;   .  󡕃5  ;,<>=* !! ~~ !/bTEM>Jݣݼ F GFILE NOT FOUND\n F GWRONG FILE TYPE\n F G%B???\nF G???pEEE!ׂ!ot necessary)\nF G position cursor\nF GCCodes for screen functions may be either characters or chG. (for now, writes out to EEE (rename to EE))\nF G DEF G\n YYf a;1pf a!1#a# T#`#a#҇a#/{qw   $GOD ҙq8Q|!?(Qo#{Q|!N7o#{ q @!da# c] #n#o#qx] #n#o 0 ...size of EE incl. header FLAG: BYTE 0 POSOFF: BYTE 0 LEADIN: BYTE 0 CLRSCR: BYTE 0 CLRLIN: BYTE 0 POSCRS: BYTE 0 INSLIN: BYTE 0 CRSLT: BYTE 0 CRSRT: BYTE 0 CRSUP: BYTE 0 CRSDN: BYTE 0 CRSHM: BYTE 0 CRSBTL: BYTE 0 CRSTAB: BYTE 0 CRSBTB: BYTE 0 RUBOB7 5B75 T%'13 ý %6` 11S06'`^XȀ###0#%##%Ȁ%Ȁ4F :I '2LP""""""##&#N#%%p#'N)R+,p1?  "a"\na- .. /093 00 99 AA FF aa ff  AAߴys!>p!x!Bء8 !  M>psXsDB!>p L>p##L>s<ҍCЯ mkU *|!oB !wNF^V~ͨ nf~ G[:Ox 0ͯ O:G(2@ `i:G(2(:*? `i:G2 *| ` :G2 ` G!=T]͟   *:"2*B 0DM!!"#C@0!ӭ] #n#o#T #`#a#X,!}ӡJQ!T#`#a#Ӳi!T#`#a#ӲT#`#a#Oq] #n#o#__!] #n#o#T #`#a#r|!m!UT: BYTE 0 LCONBUF: EQU 16 CONBUF: BYTE 0[LCONBUF] /SEG START: LDRL SAVSP,RR14; LDAR RR14,MYSP R3:=flag; RES R3,15; R3:->flag /NONSEG EECONFIG() R3:=flag; SET R3,15; R3:->flag /SEG LDRL RR14,SAVSP; RET /NONSEG LOAD: PROC ...load in filename @R3 ("E3!-{Д$1 ?1 0 !{B1 _1   !{!2/!{ }63 5.75*7{5! 00,$w4  8  0PV!>Nt1@.K! `x // ::!>L0.X/nXޞ   uު` >>a c e` >>aec  ;; << >>C6hL,!>N1.cAe!>N!@ *B 0DM[!!oR !!w"qp*:utw*ut:w!~(6ɯ2m >::*|}:: :*|} :*|}ͤ [ G: m >::[QYAaiͤ [:O "2ɹR* "'T#`#a# __!8T#`#a# a#ӜӾ n #j !L#] #n#o# [MA=!T #`#a# T#a#`# @!VL#1T #`#a#@!ԡ] #= E") R9:=R3 if R8:=open(R3,0,->RL5)=-1 then begin if RL5=0C7 then printf("%s NOT FOUND\n",R9) else ?"OPEN (of EE) ERROR ",RL5: RESFLG Z; RET end if read(R8,^BUFF,02000,->RL5)=-1 then begin ?"READ (of EE) ERROR ",RL5: close(R8) RESFLG Z ...offset in EE of ptr. to KEYVEC LSCRVEC: EQU 6 LKEYVEC: EQU 9 BUFF: DEFS 02000 SCRVECP: WORD 0 ...points to screen vector KEYVECP: WORD 0 ...points to key vector EESIZ: WORD 0 ...size of EE incl. header ERR: WORD 0 LOAD: PROC ...load in filename  ...and ... b| ...or ... b^ ...xor ... b{ ...shift left ... b} ...shift right ... b= ...compare equal ... b# ...not equal ... b< ...less than ... b> ...greater than ... b[ ...<= ... b] ...>= ...***************** QENTSZ: EQU 20 ...queue entry swill be set to 0 & the row will be set to 1" ?" [A0]" B.Getnum()->POSOFF EC2: ? ?"Do you want to change any key functions? (enter Y or N)" printf(" "); getchar(); putchar(); ? if RL3&0DF<>'Y' then JP EC3 SETB FLAG,1 KEYVECP->R3; R area ... lCNNNN ...label in code area ... DNNNN ...init'd data area ... BNNNN ...bss (uninit'd) ... dMMMMNNNN ...define symbol NNNN=symbol MMMM ... ZNNNN ...symbol may be zapped ... S1fhhhhhh ...store ... gNNNNhhhhhh ... rhhhhhh ... ihhhhhh .; RET end close(R8) R0==R0; RET SAVE: PROC ...save image to filename @R3 (EEE) if R8:=open(R3,1,->RL5)=-1 then begin ?"CREATE (of EEE) ERROR ",RL5: RESFLG Z; RET end if write(R8,^BUFF,EESIZ,->RL5)<RL5)=-1 then begin if RL5=0C7 then printf("%s NOT FOUND\n",R9) else ?"OPEN (of EE) ERROR ",RL5: RESFLG Z; RET end if read(R8,^BUFF,02000,->RL5)=-1 then begin ?"READ (of EE) ERROR ",RL5: close(R8) Rize=max code string length (19) made even NQENT: EQU 10 ...max. no. of cdstr queue entries MAXACCLVL: EQU 20 ...max. levels of accumulators in expr ...the following refer to entry on ACCSTK (part defined in CGSUB): ... REGMSK: EQU 0F ...holds register7:=^CRSLT; R1:=LKEYVEC; LDIRB @R7,@R3,R1 ?"The following cursor movement keys (as well as the DELete key used" ?"in INSERT or REPLACE modes) may be changed:" ?" '4' (cursor left)" ?" '6' (cursor right)" ?" '8' (cursor up)" ?" '2' (cursor ..indirect via item below+hhhhhh; remove item below ... ... [item cnt:-1] ... shhhhhh ...store @(sp+hhhhhh) (sp as known to C) ... 2 ... 4 ... f ... d ... bfhhhhhhooss ...insert bit field, oo=offset,ss=size of field ... gNNNNhhhhhhooss ... sfh,RL5: close(R8) RESFLG Z; RET end close(R8) R0==R0; RET GETVECAD: PROC ...get addr of SCRVEC->SCRVECP; addr of KEYVEC->KEYVECP; ... size of EE file->EESIZ (includes header) R8:=^BUFF; R6:=HDRSZ+@R8[SEGTBSZ]; R7:=R6+@R8[IMGSZ+2]->EESIZ R8:+R6 ESFLG Z; RET end close(R8) R0==R0; RET GETVECAD: PROC ...get addr of SCRVEC->SCRVECP; addr of KEYVEC->KEYVECP; ... size of EE file->EESIZ (includes header) R8:=^BUFF; R6:=HDRSZ+@R8[SEGTBSZ]; R7:=R6+@R8[IMGSZ+2]->EESIZ R8:+R6 @R8[SCRVCP]+R6->SCRVECP no. from 0..MAXREGNO ... RSZMSK: EQU 010 ...size of reg. for acc.: 1 (WRD)=word, 0=long ... WRD: EQU 010 PUSHB: EQU 7 ...bit set if reg. of entry is pushed BEGB: EQU 6 ...bit marks reg. as set by "B"egin (force reg.) func. QCUR: WORD 0 ...^queue entrdown)" ?" '7' (cursor to top left corner)" ?" '1' (cursor to bottom left corner)" ?" tab (cursor tab)" ?" '_' (cursor back-tab)" ? ?"In the following, enter the ascii value in hex of the key you want" ?"to change to or 0 if no change is hhhhhssssss ...structure; ssssss=size ... gNNNNhhhhhhssssss ... ihhhhhhssssss ... shhhhhhssssss ... F2 ...store 2-byte int in ret. register ... 4 ...4-byte ... ...etc ... B2 ...set state with 2-byte int in ret. reg. ... 4 ...4-byte, etc ... JR8+@R8[SCRVCP]->SCRVECP; R8+@R8[KEYVCP]->KEYVECP RET Getnum: PROC printf(" ") putchar(B.'>'); read(2,^CONBUF,10); R7:=^CONBUF while @R7=' ' do R7:+1 if Hexd() not then begin ?" Enter number in hex"; JR Getnum end R7:-1; HNum()->RL3 RET Getnu; @R8[KEYVCP]+R6->KEYVECP RET SAVE: PROC ...save image to filename @R3 (EEE) if R8:=open(R3,1,->RL5)=-1 then begin ?"CREATE (of EEE) ERROR ",RL5: RESFLG Z; RET end if write(R8,^BUFF,EESIZ,->RL5)<:" ?"(the standard value for each case is shown in square brackets)" ? ?"(Avoid changing to keys that have other functions; also note that" ?"with cursor movement keys, small letters (or any ascii values>=060)" ?"are equivaleANNNN ...jump always ... T2NNNN ...jp true, size of item to test=2 [item cnt:-1] ... 4NNNN ...size of item=4,etc ... F2NNNN ...jp false [item cnt:-1] ... 4NNNN ...etc ... C2cNNNN ...call returning 2-byte item; then inc sp by hhhhhh, ... i ..m2: PROC if B.Getnum()&07F>=060 then RESB RL3,5 RET EECONFIG: PROC LOAD("EE"); RET NZ ...load in EE GETVECAD() ...get addr of SCRVEC,KEYVEC; also EE size FLAG:=0 ... ?"Program to configure EE editor for different terminals." ?"Both screen : close(R8) RESFLG Z; RET end close(R8) R0==R0; RET /ERR:=0; if LOAD("EE") not then ERR:=1; GETVECAD() /IF ERR<>0 THEN *EOF /ENDIF FLAG: BYTE 0 POSOFF: BYTE 0 LEADIN: BYTE 0 CLRSCR: BYTE 0 CLRLIN: BYTE 0 POSCRS: BYTE 0 INSLIN: BYTE 0 CRSLT: B CDDATTYP: BYTE 0 CDSC: BYTE 0 CDSYM: WORD 0 CDVALOFF: LONG 0 CDSTRCSZ: LONG 0 CDBITO: BYTE 0 ...could be on top of CDSTRCSZ CDBITSZ: BYTE 0 ...used by UNARYOP,BINARYOP: TYPSU1: WORD ...gets size/type+signed/unsigned chars of result TYP1: BYTE 0 SU1: BYnt to capital)" ?" '4' (cursor left) [34] ->" if B.Getnum2()<>0 then RL3->CRSLT ?" '6' (cursor right) [36] ->" if B.Getnum2()<>0 then RL3->CRSRT ?" '8' (cursor up) [38] ->" if B.Getnum2()<>0 then RL3->CRSUP ?" '2' (cursor down) [32] .call via last item [item cnt:-1] ... 4 ...returning 4-byte item ... d ...ret'ing double ... scNNNNssssss ...ret'ing structure; ssssss=size (not really needed) ... issssss ... ...("C"all adds item to accum. stack) ... sTTTT ...dec sp to reserve sfunction codes and keys for cursor movement (+delete key)" ?"may be changed." ? ?"Do you want to change screen function codes? (enter Y or N)" printf(" "); getchar(); putchar(); ? if RL3&0DF<>'Y' then JP EC2 SETB FLAG,0 ?"The follo= YTE 0 CRSRT: BYTE 0 CRSUP: BYTE 0 CRSDN: BYTE 0 CRSHM: BYTE 0 CRSBTL: BYTE 0 CRSTAB: BYTE 0 CRSBTB: BYTE 0 RUBOUT: BYTE 0 CONBUF: BYTE 0[10] Getnum: PROC printf(" ") putchar(B.'>'); read(2,^CONBUF,10); R7:=^CONBUF while @R7=' ' do R7:+1 if Hexd() TE 0 TYPSU2: WORD ...ditto 1st operand TYP2: BYTE 0 SU2: BYTE 0 TYPSU3: WORD ...ditto 2nd operand TYP3: BYTE 0 SU3: BYTE 0 ...CDOP: BYTE 0 ...gets opcode char ...ADMODE: BYTE 0 ...0=reg., 'K'=const. ...OPDVAL: LONG 0 ...operand value (if 'K') CODEGE->" if B.Getnum2()<>0 then RL3->CRSDN ?" '7' (cursor to top left corner) [37] ->" if B.Getnum2()<>0 then RL3->CRSHM ?" '1' (cursor to bottom left corner) [31] ->" if B.Getnum2()<>0 then RL3->CRSBTL ?" tab (cursor tab) [09] ->" if B.Getnupace for args; TTTT is label ... referred to later by "r" ... rhhhhhhTTTT ...inc sp by hhhhhh, also am't for "s" (@label TTTT); ... zap TTTT ... ETTTT ...enter func.; TTTT is symbol which gets info supplied ... later by "X" ... XllllllaabbTTTT ..wing screen functions are used:" ?" clear screen" ?" clear line (either all or past cursor)" ?" insert line (not necessary)" ?" position cursor" ?"Codes for screen functions may be either characters or characters" ?"preceded by a lead-in not then begin ?" Enter number in hex"; JR Getnum end R7:-1; HNum()->RL3 RET Getnum2: PROC if B.Getnum()&07F>=060 then RESB RL3,5 RET EECONFIG: PROC ?"Program to configure EE editor for different terminals." ?"Both screen function codes anN: PROC ...enter with R3=^code string; add it to queue & maybe flush ... queue (put out code for each entry in order) save R8 R8:=R3 if QCUR<>0 then QNXTOUT:=0 ...if prev. aborted in middle of stuff if QNXTIN=QNXTOUT then begin CDGEN(R3:=QNXTOUT->m2()<>0 then RL3->CRSTAB ?" '_' (cursor back-tab) [5F] ->" if B.Getnum2()<>0 then RL3->CRSBTB ?" DEL (delete in INSERT/REPLACE mode) [7F] ->" if B.Getnum()&07F<>0 then RL3->RUBOUT EC3: if FLAG=0 then JP EC4 ?"Do you want to write out new E.exit func; llll=am't of local storage, ... aa,bb=#regs to save; TTTT is symbol used to ... communicate info when "enter func" filled in; ... zap TTTT ... D2 ...duplicate item of size 2 ... 4 ...size 4, etc ... R ...remove item [item cnt:-1] .character (such as escape)" ?"(`pos. cursor' will then have 2 more chars. for the X & Y positions)" ? ?"Below, enter all values in hex followed by a :" ?"(in each case, an example value valid for an Infoton 200 terminal is" ?"shown in square b...code generator ...passed intermediate language @R3 as follows: ... L1fhhhhhh ...load 1 byte from @(fp+hhhhhh) ... gNNNNhhhhhh ...load NNNN+hhhhhh; NNNN=number of external ... cNNNN ...load NNNN; NNNN=symbol in code area (not used) ... ihhhhhh ..QCUR) end ADDQ(R8) if FLSQCD(B.@R8) then FLSQ() QCUR:=0 restore R8 RET ADDQ: ...enter with R3 pointing to code string; add it to cdstr queue R1:=QNXTIN; R0:=QENTSZ/2 if QNXTOUT=0 then R1:->QNXTOUT LDIR @R1,@R3,R0 if R1=^QEND then R1:=^CDSTRQ R1E with changes? (enter Y or N)" ?" (for now, writes out to EEE (rename to EE))" printf(" "); getchar(); putchar(); ? if RL3&0DF='Y' then begin if BITB FLAG,0 not zero then begin R7:=SCRVECP; R3:=^POSOFF; R1:=LSCRVEC; LDIRB @R7,@R3,R1 .. . ...finish codegen to this point ... uV2s1u ...convert char->2 byte int ... 4sp_ ...ptr->4-byte int ... 4u2s ...signed 2-byte->unsigned 4-byte int ... 2s4s ...signed 4->2 ... f_4s ...signed 4-byte int->float ... ...etc ... un2s2s ...nerackets)" ? ?"If any function requires a lead-in, enter lead-in character, else 0:" ?" Example: if lead-in character=escape, enter 1B" ?" [00]" B.Getnum()->LEADIN ?"In the following, give code for the function plus set high bit (bit 7)" ?"if i.load indirect via last item+hhhhhh [item cnt:-1] ... rhhhhhh ...load from reg. hhhhhh ... Khhhhhhhh ...immediate ... 2 ...ditto other sizes ... 4 ... pfhhhhhh ...load addr ... gNNNNhhhhhh ... cNNNN ... ihhhhhh ... f ...float ... d ...dou:->QNXTIN RET FLSQ: ...flush cdstr queue (do each in order); set QNXTOUT=0 ...assumed at least 1 entry R3:=QNXTOUT repeat R3:->QCUR CDGEN(R3) until R3:=QNXTOUT=0; RET FLSQCD: ...enter with RL3=1st byte of code string ...ret. Z=1 if should fl end if BITB FLAG,1 not zero then begin R7:=KEYVECP; R3:=^CRSLT; R1:=LKEYVEC; LDIRB @R7,@R3,R1 end SAVE("EEE") end EC4: RET END: BUFF: DEFS 02000 DEFS 0100 MYSP: /MAP UNDEF /WRITE "Type in:" /WRITE "/IMAGE EECONFIG ",BEG," ",END," Egate int ... 2s1u ...char->int & negate ... f_f_ ...negate float ... ...etc ...... u!2u2u ...not unsigned int ...... ...etc ... u~4s4s ...complement 4-byte int ... ...etc ... b+2s1u2s ...add char+int->int ... d_f_2u ...add float+unsigned int needs a lead-in character:" ?" clear screen: [0C]" B.Getnum()->CLRSCR ?" clear line: [0B]" B.Getnum()->CLRLIN ?" insert line (enter 0 if don't have): [00]" B.Getnum()->INSLIN ?" position cursor: [17]" B.Getnum()->POSCRS ?" entble ... bfhhhhhhooss ...extract bit field, oo=offset,ss=size of field ... gNNNNhhhhhhooss ... ihhhhhh ... sfhhhhhhssssss ...structure; ssssss=size (don't need size, may change) ... gNNNNhhhhhhssssss ... ihhhhhhssssss ... ...("L"oad adds item toush queue, Z=0 if should delay RL3=='I'; RET Z; RL3=='U'; RET Z; RL3=='X'; RET Z; RL3=='.'; RET Z RL3=='J'; RET Z; RL3=='R'; RET Z; RL3=='E'; RET INCNXTOUT: ...pt. QNXTOUT to next queue entry to be done ...if to QNXTIN, set=0 QINC(1,QNXTOUT)->QNXTOUT;=",START  configure EE screen editor (Z8000) for different terminals FNFERR: EQU 0C7 ...error code for file not found HDRSnd EC4: RET END: BUFF: DEFS 02000 DEFS 0100 MYSP: /MAP UNDEF /WRITE "Type in:" /WRITE "/IMAGE EECONFIG ",BEG," ",END," Et->double ... 2s2s2s ...add signed 2-byte ints ... p_2up_nnnnnn ...unsigned int+ptr->ptr; nnnnnn=size of object pt'd to ... 4s4s1u ...4-byte int+char->4-byte int ... ...etc ... b- ...subtract ... b* ...mult. ... b/ ...div. ... b% ...mod ... b& er offset for X & Y positioning characters plus set high bit" ?" if order is to be XY (column first, then row) rather than YX" ?" (row first, then column):" ?" Example: 'A0' means if the 2 chars. sent are '20' then '21', the" ?" column  accum. stack) ... I1hh ...initialize with byte ... 2hhhh ...with word ... 4hhhhhhhh ... pNNNNhhhhhh ...pointer to NNNN+hhhh ... feeffffffffff ...float initialize (exp=excess 128, sign=high f bit) ... Uhhhhhh ...reserve hhhhhh bytes in uninit'd data>  RET QPTR: ...enter with R3=no. of queue spots ahead of QCUR to get ptr to ...ret. R3=^queue spot R5:=QCUR QINC: ...enter here with R5=^queue spot to start R0:=R3 while R0<>0 do begin if R5:+QENTSZ=^QEND then R5:=^CDSTRQ if R5=QNXTIN then begin 'D': DUPLICATE() 'R': REMOVE() '.': FINISH() 'u': UNARYOP() 'b': BINARYOP() 'k': BINYOPK() end INCNXTOUT() restore R8 RET INITLZE: ...put out value in (init'd) data area according to format @R3 save R6..R9 R8:=R3 RL0:=@R8' if RL0='pmbol# CGLKUP(R3)->R7 FIXDECSP(LDL RR2,RR8; R5:=R7) ...fill in "dec sp", poss. adjusting code & AREFTAB SET CGFLG[R7],ZAPB ...put out call if CDSC='c' then begin PUTBSCALL() CGLKUP(CDSYM)->R5 ST_AREF(RL3:='C'; R5:) ...; LDL RR0,CDPTR) ... f index R3=`load variable' if R1:=QPTR(R3)<>0 and B.@R1='L' then begin if RL0:=@R1[2]='g' or RL0='f' or RL0='r' then begin if RL0:=@R1[1]>='1' and RL0<='4' or RL0='b' then begin R0==R0; RET end end end RESFLG Z; RET COMMTKON: ...if atn ...if value not fixed ST_AREF(B.'l',R8) SET CGFLG[R8],UNFIXB SET CGFLG[R8],DEFNB R3:=R9-CGTABBSE; R2:=0 end else begin if BIT CGFLG[R8],CHAINB not zero then begin RESOLVCH(R3:=R9; LDL RR4,R8[ADRHI]) RES CGFLG[R8],CHAINB end R3:=0; RET end if B.@R5<>' ' then R0:-1 ...don't count noop spots end R3:=R5; RET MRKEMPT: ...enter with R3=index past QCUR to start, R5=no. of queue spots to ... mark as noop (' ') save R6,R7 R6:=R3; R7:=R3+R5 while R7:-1>>=R6 do begin R3:=QPTR' then begin ...addr ref InhexW(R8)->R3; CGLKUP(R3)->R7 InhexO(R8:+4->R3); LDL RR0,RR2 ST_AREF(B.'A',R7) ...also passes RR0=disp ... if BIT CGFLG[R10],CGUNDEFB not zero then begin ... if TESTL RR6 not zero then NDFERR() ... PUTCHAIN(R3 INCCDPTR(SZPOINT) end else begin RL3:=ACCSTK[ACCLVL]->RL6 ...get indr reg. RELREG() ...remove indr reg from accstk without doing pop if TESTL RR8 not zero then begin ...if were any args PUTSLDV(RL3; RL5:=SZPOINT; LDL RR0,RR8) ...load ind `load const' (prev. combined), & following=load var., then ... commutative binop, switch order of loads in queue ...enter R3=queue index; (could combine with GRPKONS) save R8,R9 R8:=R3 if LDKON(R3) and LDVAR(R8+1) then begin if R9:=QPTR(R8+2)<>0 a LDL RR2,R9[ADRHI] end LDL R8[ADRHI],RR2 RES CGFLG[R8],CGUNDEFB restore R8,R9 RET ZAP: ...zap symbol# @R3 or mark zappable R5:=R3 InhexW(R3)->R3 CGLKUP(R3)->R1 if BIT CGFLG[R1],UNFIXB zero then SET CGFLG[R1],CGZAPB else SET CGFLG[R1],CANZAPB (R7); RL0:=' '->@R3 end ...go backwards since QPTR will skip over spot already set to ' ' restore R6,R7 RET SWTCHCS: ...enter with R3=q index; switch next 2 cdstrq entries save R8,R9 R9:=R3 R8:=QPTR(R3); R9:=QPTR(R9+1) R15:-QENTSZ->R1 ...use sta:=R10; LDL RR4,DTAPTR) ... end else begin ... if BIT CGFLG[R10],UNFIXB zero then begin ...if value fixed ... LDL RR2,R10[ADRHI]; ADDL RR2,RR6 ... WRADR_D(LDL RR4,DTAPTR) ... ...also put in relocation table ... end else begin ... r reg from stack end PUTCALLI(RL6) ADDL RR8,#SZPOINT end PUTINCSP(LDL RR2,RR8) ...handle ret. value RL3:=ACCSZ(CDDATTYP) REQREG2(RL3|RETREG) ...make RETREG acc. restore R6..R9 RET ENTERFTN: ...@R3=symbol# to use for getting am't of local nd B.@R9='b' then begin if RL0:=@R9[1]='+' or RL0='*' or RL0='&' or RL0='|' or RL0='^' then begin ...switch order (also of types in binop) R0:=@R9[4]; @R9[6]->@R9[4]; R0:->@R9[6] SWTCHCS(R8) end end end restore R8,R9 RET BINOPRET JUMP: ...@R3='A'/('T'/'F')(size char), then symbol# to jp to ...or modified: 'T'/'F'->'=','<',etc ...put out full-size jp & make entry in AREFTAB ...if 'T'/'F', do initial TEST 0 save R6,R7 if RL6:=@R3'<>'A' then RH6:=@R3' InhexW(R3)->R7 ... CGLck for tmp. storage R0:=QENTSZ/2; R3:=R8; LDIR @R1,@R3,R0 R0:=QENTSZ/2; R3:=R9; LDIR @R8,@R3,R0 R0:=QENTSZ/2; LDIR @R9,@R15,R0 restore R8,R9 RET GRPKONS: ...if queue index R3 is at `load const.', see if can group more ... constants together & rewrit if TESTL RR6 not zero then begin ... Errm(); DEFT 'FUNC+OFFSET' ...poss. could do FIXAREFS ... end ... ST_AREF(RL3:='A'; R5:=R10; LDL RR0,DTAPTR) ... end ... end .... R9:=SZPOINT end else begin ..."f"loat type not currently used (space & regs used ... (given when have "exit func") ...save space in code area for "enter func" sequence ...also init. ACCLVL InhexW(R3)->R3 CGLKUP(R3)->R5 ST_AREF(RL3:='E'; R5:) ...; LDL RR0,CDPTR) ... INCCDPTR(SZENTR) INITCG() RET EXITFTN: ...@RKON: ...R3=q index; if at `load const' + binop, do operation on constant save R7..R10 R8:=R3 LDKON(R3); LDL RR10,RR2 if zero and R9:=QPTR(R8+1)<>0 and B.@R9='b' and B.@R9[2]<>'d' then begin B.'k'->@R9 if B.@R9[2]='p' then begin InhexO(R9+8)KUP(R3)->R7 RL3:=0 if RL6<>'A' then begin if RL6='T' or RL6='F' then begin RH3:=RH6; RL3:='_' ...RL3 dummy R3:=ADJTYPSU(R3); RH6:=RH3 RL3:=SETACC() ...convert 'f' to 'd' if not same PUTTEST(RL3,RH6) end REMOVE() SETRe queue (may set some to ' '=noop) save R6..R11 R8:=R3 if R3:=KON(R3) and R9:=R3-1>R8 then begin ...KON rets. R3=queue index past all consts, RR4=value, RL1=size char RL7:=RL1; LDL RR10,RR4 R6:=QPTR(R8) RL7:->@R6[1]; OuthexL(LDL RR2,RR10; R7see OUTDAT in CDECL) R9:=R0&0F if R9=4 then begin InhexW(R8)->R6; InhexW(R8+4)->R7 end else if R9=2 then InhexW(R8)->R7 else InhexB(R8)->RL7 WRDATA(LDL RR2,RR6; LDL RR4,CDPTR; R1:=R9) INCCDPTR(R9) end restore R6..R9 RET UNINIT: ...@R33=size of local space, then no. A-type regs, then no. B-type regs ...then symbol# to use for holding above info until "enter func" ... resolved during FIXAREFS (if chain, fill in "enter func" with max ... size); also put out "exit func" save R8..R11 R; MULTL RQ0,RR10 end else LDL RR2,RR10 OuthexL(R7:=R9+8) MRKEMPT(0,1) ...don't need to load const end restore R7..R10 RET RELOPCS: ...chk if cdstr @R3=relop if RL0:=@R3='b' or RL0='k' then begin if ISAROP(B.@R3[1]) not then begin R0==R0; EGSJP() ...if top of accstk='begin' reg., make sure unpushed, ... else push all regs. RL3:=RL6 case RL6: of 'F': RL3:='=' 'T': RL3:='#' end end ...here RL3=corres. relation op char for PUTJMP PUTJMP(RL3,B.'s',R7) restore R6,R7 R:=R6+3) MRKEMPT(R8+1,R9-R8) ...mark now unused q spots as noop end restore R6..R11 RET KON: ...enter with R3=current queue index ...ret. Z=1 iff have constant or const. expr here, R3=new queue index ... (past all constants); RR4=value of const., > =am't of space to reserve in uninit'd data region InhexO(R3) ...->RR2 INCBSSPTR() RET FINISH: ...finish code generation to this point FIXAREFS() INITCG() ...could also pack CGTAB if near full & didn't just do RET INITCG: ...do init'n for putting 8:=R3 InhexO(R3); LDL RR10,RR2; R8:+6 InhexW(R8)->R9; R8:+4 ...R9=(no. A-regs)*256+(no. B-regs) InhexW(R8)->R3 CGLKUP(R3)->R8 PACKEINFO(LDL RR2,RR10; R5:=R9) ...pack local space & reg info into RR2 LDL RR10,RR2 ...local space+reg info if BIT CGFLGRET end end RESFLG Z; RET RELOPJP: ...chk for relop followed by jp; change to compare + jp(=,#,<,etc) ...R3=q index save R8,R9 R9:=R3 if R8:=QPTR(R3)<>0 and RELOPCS(R8) and R9:=QPTR(R9+1)<>0 and B.@R9='J' then begin if RL0:=@R9[1]='T' or RL0ET PUTJMP: ...enter with RL3=rel. op char (=#etc), RL5=sign char (s/u), ... R1=snum of dest. symbol save R8 R8:=R1 PUTBSJP(RL3,RL5) R5:=CGLKUP(R8) ST_AREF(RL3:='J'; R5:) ...; LDL RR0,CDPTR) ... INCCDPTR(SZPOINT) restore R8 RET DECSP: ...@R3=labelRL1=size char ('2','4') save R6..R13 R6:=R3 if LDKON(R3) then begin LDL RR8,RR2; RL7:=RL5 ...value,size R6:+1 while R10:=QPTR(R6)<>0 and B.@R10='u' do begin RH1:=@R10[2]->RL7; RL1:=@R10[3] UNYCALC(LDL RR2,RR8; RL5:=@R10[1]; R1:); LDLout code if ACCLVL<>-1 then ?"ACCLVL FIXED" ...tmp ACCLVL:=-1 RET LABL: ...make label; region+symbol# @R3 save R6 RL6:=@R3' InhexW(R3)->R5 DEFLAB(RL6,R5) restore R6 RET DEFLAB: ...make label; RL3=region, R5=symbol# save R6,R7 RL6:=RL3 CGLKUP([R8],CHAINB not zero then begin ...if FIXAREFS done since "enter func" PUTENTR(LDL RR4,R8[ADRHI]; R1:=SZENTR) SET CGFLG[R8],ZAPB end else begin LDL R8[ADRHI],RR2 RES CGFLG[R8],CGUNDEFB SET CGFLG[R8],CANZAPB end PUTEXIT(LDL RR2,RR10; LD='F' then begin RL3:=@R8[1] if RL0='F' then RL3:=INVRELOP(RL3) RL3:->@R9[1] B.':'->@R8[1] end end restore R8,R9 RET INVRELOP: ...enter with RL3=(=#<>[]); ret. RL3=inverse case RL3: of '=': RL3:='#' '#': RL3:='=' ; put label in AREFTAB & save space in code area for ... "dec sp"; also push any unpushed regs. on ACCSTK save R6 InhexW(R3)->R6 PSHREGS() DEFLAB(B.'C',R6) INCCDPTR(SZDECSP) ... if R1:=ACCLVL>>=0 then SETB ACCSTK[R1],ENDSECB restore R6 RET CALLFTN RR8,RR2 R6:+1 end R11:=R6 while R3:=KON(R6) do begin R6:=R3; LDL RR12,RR4 R10:=QPTR(R3) if R10=0 or B.@R10<>'b' then begin R6:=R11; JR KONF end BINCALC(LDL RR2,RR8; LDL RR4,RR12; RL1:=@R10[1]) LDL RR8,RR2 RL7:=@R5)->R7 ... if RL6='D' then begin ... SET CGFLG[R7],DTASYMB ... XLDATADR(LDL RR2,DTAPTR) if RL6='B' then begin SET CGFLG[R7],BSSSYMB XLBSSADR(LDL RR2,BSSPTR) LDL RR4,R7[ADRHI] LDL R7[ADRHI],RR2 if BIT CGFLG[R7],CHAINB not zero then RESOL RR4,CDPTR) GETEXITSZ(LDL RR2,RR10)->R3 INCCDPTR(R3) restore R8..R11 RET SETIREG: ...chk if reg. on accstk=addr reg; if not, change to addr reg ...ret. RL3=the reg (as on accstk); then remove reg. from accstk save R6,R7 RL6:=ACCSTK[ACCLVL]->RL7 R '<': RL3:=']' '>': RL3:='[' '[': RL3:='>' else RL3:='<' end RET OPTIM: ...poss. rewrite code strings GRPKONS(0) ...see if can group constants together COMMTKON(0) ...see if can switch constant to right side BINOPKON(0) ...chk for binar: ...@R3=size of item returned from ftn, then 'c'/'i' for ext/ind ... if 'c', symbol# follows (poss. struct size not used) ...here save values & put out call when have following "r" (RESSP) RL0:=@R3'->CDDATTYP RL0:=@R3'->CDSC if RL0='c' then InhexW(R3R10[2] R6:+1 end R0:=1 end else begin KONF~ R0:=0 ...false end R3:=R6; LDL RR4,RR8; RL1:=RL7 restore R6..R13 R0==1; RET LDKON: ...chk if queue spot of index R3=`load const.' ...if so, ret. Z=1, RR2=value, RL5=size char. PUSH R6 R1:=QLVCH(R7) ...also passes RR4 end else begin ...if 'C'/'D' if RL6='C' then begin LDL RR0,CDPTR R1:+(ALFTN-1)&(-ALFTN) LDL CDPTR,RR0 ...make sure CDPTR even (poss. not if was error) end ST_AREF(B.'l',R7) ...delay marking def'd EMOVE() if NOTADRREG(RL6) then begin B.REQADRREG()->RL3->RL7 PUTLDREG(RL3,RL6) REMOVE() end RL3:=RL7 restore R6,R7 RET LOAD: ...@R3=format of what to load: size; sclass, incl. offset, poss. symbol ... name or value; poss. supp. info (structy op by const RELOPJP(0) ...chk for compare+jp RET CDGEN: PROC ...enter with R3=^code string in cdstr queue; put out approp. code ...may also use prev. & later code strings in queue (ref ^CDSTRQ,LASTQ) save R8 R8:=R3 OPTIM() R3:=R8 case RL0:=@R3)->CDSYM RET RESSP: ...@R3=am't to inc sp, then symbol# of prev "s" label where should ... fill in "dec sp" for same am't ...fix up AREFTAB to remove "l" entry (from prev "s") & zap symbol ...also have CDDATTYP,CDSC,CDSYM set in CALLFTN ...if CDSC='cPTR(R3) if R1<>0 and B.@R1='L' and B.@R1[2]='K' and RL6:=@R1[1]>='1' and RL6<='4' then begin InhexL(R1+3) ...->RR2 RL5:=RL6 R0==R0 end else RESFLG Z POP R6; RET UNYCALC: ...do RR2=(unary op)RR2; RL5=unary op ('V','n','~'), ... RH1,RL1=sizeuntil after ST_AREF in case does FIXAREFS if RL6='D' then SET CGFLG[R7],DTASYMB else SET CGFLG[R7],CDSYMB SET CGFLG[R7],UNFIXB XLCDADR(LDL RR2,CDPTR) LDL R7[ADRHI],RR2 end RES CGFLG[R7],CGUNDEFB restore R6,R7 RET DEFINE: ...define label; s size/bit field info) save R6,R7 R7:=R3 RDCDSTR(R7) RH6:=CDSC; RH7:=CDDATTYP ...for efficiency if RH6='i' then B.SETIREG()->IREG if RH7='p' or RH7='s' then RL6:=REQADRREG() else RL6:=REQREG(RH7) B.DATSZ(RH7)->RL7 RL3:=RL6; RL5:=RL7; LDL RR0,CDVAL' of 'I': INITLZE() 'U': UNINIT() 'L': LOAD() 'l': LABL() 'd': DEFINE() 'Z': ZAP() 'S': STORE() 'F': FORCE() 'B': BEGFORC() 'C': CALLFTN() 'J': JUMP() 's': DECSP() 'r': RESSP() 'E': ENTERFTN() 'X': EXITFTN() ', put out full-size call & make entry in AREFTAB; else ... put out call indirect via reg on stack above args ...restore stack & enter ret. value into expr save R6..R9 R7:=R3 InhexO(R7); LDL RR8,RR2; R7:+6 ...inc sp am't InhexW(R7)->R3 ...dec sp sy/signness chars for result ('2s',etc) if RL5<>'V' then begin COM R2; COM R3 if RL5='n' then ADDL RR2,#1 end if RH1='1' then RH3:=0 ...assumes no '1s' if RH1<'4' then begin R2:=0 if RL1='s' then EXTS RR2 end RET LDVAR: ...chk if q spot oymbol# to define equal to @R3 (has been prev. def'd), ... after that this symbol# save R8,R9 R8:=R3 InhexW(R3)->R3; CGLKUP(R3)->R9 InhexW(R8+4)->R3; CGLKUP(R3)->R8 @R9[CGFLG]®NMASK|@R8[CGFLG]->@R8[CGFLG] if BIT CGFLG[R9],UNFIXB not zero then begi? OFF ...args for PUT..()s below case RH6: of 'K': PUTLDCON() 'r': PUTLDREGV() 'f': begin if RH7='p' or RH7='s' then PUTFLDA() else PUTFLDV() end 'i': begin ...PUT routines also get passed IREG if RH7='p' or RH7='s' then PUET BEGFORC: ...set up state with ret. reg. as (only) active accum.; @R3=size ACCSZ(B.@R3)|(RETREG|2**BEGB)->ACCSTK[0] ...BEGB marks reg as set here ACCLVL:=0 RET DUPLICATE: ...get another reg., dup. accum. in it (@R3=size char) save R6,R7 RL7:=@R3 ot free, push it (& any prior unpushed accs.) ...put on accstk; ret. as on accstk in RL3 save R6 RL6:=RL3 B.NXTREG2()->RL3 REQREG2(RL3|RL6) restore R6 RET REQADRREG: PROC ...get free reg.<>last 1 which can be used for indirect ref ... for accum.;'s' then STSTRC2() else STBITF2() end else PUTSTI() end 's': begin ...stack ptr rel. if RH7='s' then begin B.REQADRREG()->RL3 ...->RH6 ...GETSTKOFF()->R1; R0:=0; ADDL RR0,CDVALOFF ...PUTSLDA(RH6,SZPOINT) ...also passealso passes OPDVAL,CDOP JR BINOPX end end ADJTYPSU(TYPSU1)->TYPSU1; ADJTYPSU(TYPSU2)->TYPSU2 ADJTYPSU(TYPSU3)->TYPSU3 if ISAROP(RH6) then begin R8:=TYPSU1 RL6:=CONVERT(RL6,R8,TYPSU2) if RH6='{' or RH6='}' then R8:=(SZINT+'0')*0100+'s' TILDA() else PUTILDV() end else begin ...'g'/'c' if RH7='p' or RH7='s' then begin PUTDBSLDA() ... if RH6='g' then PUTDBSLDA() else PUTCBSLDA() end else begin PUTDBSLDV() ...shouldn't be LDV from code end  RL6:=SETACC() B.REQREG(RL7)->RL3 PUTLDREG(RL3,RL6) restore R6,R7 RET REMOVE: ...take off last item from accstk if ACCLVL<<0 then begin Errm(); DEFT 'COMPILER ERR ' ...shouldn't be necessary end SETACC() ...if acc pushed, pop it RELREG() RET if next one not free, push it (& any prior unpushed) ...put on accstk; ret. as on accstk in RL3 save R6 B.ACCSZ(B.'p')->RL6 B.NXTADRREG()->RL3 ...get no. for addr reg. REQREG2(RL3|RL6) restore R6 RET REQREG2: ...enter RL3=register no.+RSZMSK ...s RR0 PUTSLDA(RL3; RL5:=SZPOINT; LDL RR0,CDVALOFF) STSTRC2() ...store struct. end else begin ...GETSTKOFF()->R1; R0:=0; ADDL RR0,CDVALOFF PUTSTS() ...(RL6,RL7) ...also passes RR0 end end else begin ...'g'  if ADMODE=0 then RL7:=CONVERT(RL7,R8,TYPSU3) else begin UNYCALC(LDL RR2,OPDVAL; RL5:='V'); LDL OPDVAL,RR2 end PUTAROP(RL6,RL7,R8) ...also passes CDOP,ADMODE,OPDVAL end else begin ...relational ops R8:=HIESTTYP(TYPSU2,TYPSU3) RL6:=CONVERT( PUTSTTADR() ...put out addr @CDPTR end end if RH7='b' then ADJBITF(RL6) ...if can do extract bit field, combine ADJBITF with PUTFLDV,etc restore R6,R7 RET PUTSTTADR: ...put out static address @CDPTR; inc CDPTR ...have variables CDSYM,CDSC RELREG: ...release last acc. ACCLVL:-1; RET UNARYOP: ...enter @R3=unary op code + 2-byte size/type for result + 2-byte ... starting size/type (1u,2s,2u,4s,4u,p_,f_,d_) save R6,R7 R7:=R3 RL6:=@R7' RDTYP1(R7); R7:+2; RDTYP2(R7) ...get TYPSU1,TYPSU2put on ACCSTK; if have prev. entry not pushed, push it ...ret. RL3=same save R6 RL6:=RL3 if ACCLVL:+1>=MAXACCLVL then TUDEEP() RL6:->ACCSTK[ACCLVL] PSHPRV(RL6) ...chk if need to push prev. instance of reg. RL3:=RL6 restore R6 RET NXTREG2: ...getif RH7='s' or RH7='b' then begin ...if struct or bit field B.REQADRREG()->RL3 PUTDBSLDA(RL3; RL5:=SZPOINT; LDL RR0,CDVALOFF) end else begin PUTDBSST() end PUTSTTADR() ...put out addr. if RH7='s' then STSTRC2() ..RL6,R8,TYPSU2) if ADMODE=0 then RL7:=CONVERT(RL7,R8,TYPSU3) else begin UNYCALC(LDL RR2,OPDVAL; RL5:='V'); LDL OPDVAL,RR2 end R1:=R8; RL0:=TYP1 PUTRELOP(RL6,RL7) ...also passes RR0,CDOP,ADMODE,OPDVAL end BINOPX~ if ADMODE=0 then REMOVE() B.C,CDVALOFF ... save R8,R9 CGLKUP(CDSYM)->R5 ST_AREF(RL3:='D'; R5:; LDL RR0,CDVALOFF) ... if BIT CGFLG[R8],CGUNDEFB not zero or CDSC='c' then begin ... ...if not defined or code ref. ... if CDSC='g' then begin ... if TESTL CDVALOFF not zero then NDF ADJTYPSU(TYPSU1)->TYPSU1; ADJTYPSU(TYPSU2)->TYPSU2 RL3:=SETACC() ...->RH6 ... if RL6<>'!' then begin RL3:=CONVERT(RL3,TYPSU1,TYPSU2)->RH6 ...convert from TYPSU2->TYPSU1 RL5:=TYP1 case RL6: of 'n': PUTNEG(RL3,RL5) '~': PUTCOMPL(RL3,RL reg. no. for acc.<>last 2 regs. on accstk RL0:=NXTREG() if ACCLVL>>=1 and RL0=ACCSTK[ACCLVL-1]®MSK then begin if RL0:+1>MAXREGNO then RL0:=RETREG end RL3:=RL0 RET NXTREG: ...get next reg. no. for accumulator->RL3 ...(numerically after last on.if struct. if RH7='b' then STBITF2() ...if bitfld end end restore R6,R7 RET STSTRC2: ...enter with top 2 levels of accstk containing ^struct,^dest (top) ... (both unpushed); also have CDSTRCSZ ...put out store of struct. leaving orig. ^struNVTACC(RL6,TYP1)->ACCSTK[ACCLVL] restore R6..R8 RET HIESTTYP: ...enter R3,R5=2 typsu's ('2s' etc) ...ret. R3=highest one, including round up to at least '2x' ...('f' prev. made 'd', 'p' prev. made '4u' (or '2u')) RH3=='d'; RET Z RH5=='d'; JR Z,HITYERR() ... RL3:='D' ... end else RL3:='a' ...if 'c' ... ST_AREF(RL3; R5:=R8; LDL RR0,CDPTR) ... R3:=SZPOINT ... end else begin ...if defined ref. to data ... GETDADRSZ(LDL RR2,R8[ADRHI])->R9 ... ADDADOFF(LDL RR2,R8[ADRHI]; LDL RR4,CDVALOFF) 5) end ... end else begin ... ...if TYP2='f', cnvt to 'd' (if diff) ... ADJTYPSU(TYPSU2)->R3; RL1:=RH3 ... PUTNOT(RH6,TYP1,RL1) ... RH6:=CNVTACC(RH6,TYP1) ... end RH6:->ACCSTK[ACCLVL] restore R6,R7 RET CONVERT: ...enter with R5=size/type+(sie on accstk) RL1:=RETREG if ACCLVL>>=0 then begin RL1:=ACCSTK[ACCLVL]®MSK+1 if RL1>MAXREGNO then RL1:=RETREG end RL3:=RL1 RET NXTADRREG: ...get next reg. no. which can be used for indirect ref.->RL3 ...machine dep. if RL3:=NXTREG()=MAXREGNct valid; remove ^dest. ...note: can clobber ^struct if next cdstrg='R' save R6,R7 RH6:=ACCSTK[ACCLVL]; RL6:=ACCSTK[ACCLVL-1] B.REQADRREG()->RL3->RH7; PUTLDREG(RL3,RL6) ...above not necessary if acc=addr reg. & 'R' follows (set RH7 tho) PUTSTSTRC(RPX R3=='4'*0100+'u'; RET Z R5=='4'*0100+'u'; JR Z,HITYPX RH3=='4'; RET Z RH5=='4'; JR Z,HITYPX R3=='2'*0100+'u'; RET Z R5=='2'*0100+'u'; JR Z,HITYPX R3:='2'*0100+'s'; RET HITYPX~ R3:=R5; RET AROPS~ BYTE '+' '-' '*' '/' '%' '&' '|' '^' '{' '}' NAROP ...RR2=addr+offset ... PUTDATADR(LDL RR4,CDPTR; R1:=R9) ... R3:=R9 ... end ... INCCDPTR(R3) ... restore R8,R9 RET ADJBITF: ...enter with RL3=reg., also have CDBITO,CDBITSZ ...right-justify bitfield in reg. save R6 RL6:=RL3 RL1:=CDBITO; RH1:=0 P? gned/unsigned) to convert reg# in ... RL3 to, R1=starting size/type (ADJTYPSU prev. done) ...do convert; ret. RL3=updated (by size) reg. for accstk save R6,R7 RL7:=RL3; R6:=R5; ...R7:=R1 ...for now, ignore float if RH6<>'d' and RH1<>'d' then begin O then RL3:=RETREG RET NOTADRREG: ...ret. Z=1 iff reg. no. not valid for indirect ref. ...machine dep. RL3==MAXREGNO; RET PSHPRV: ...chk entries on ACCSTK below ACCLVL to see if same as RL3; if so, ... put out push & mark pushed on accstk ...(also fL3:=RH7; RL5:=RH6; LDL RR0,CDSTRCSZ) REMOVE(); REMOVE() restore R6,R7 RET STBITF2: ...enter with top 2 levels of accstk containing bitfld val,^dest (top) ... (both unpushed); also have CDBITO,CDBITSZ ...put out store of bitfield leaving orig. acc. vaS~ EQU 10 ISAROP: ...chk if RL3=code for binary arithmetic op R5:=^AROPS; R1:=NAROPS; CPIRB RL3,@R5,R1,EQ; RET CNVTACC: ...enter with RL3=reg., RL5=size/type char ('2','4','p',etc) ...ret. RL3=same reg. of approp. size save R7 RL7:=RL3®MSK if DATUTSHFT(RL3,'2'*0100+'u',-R1) if CDBITSZ<>(SZINT*8) then begin R5:=PWR2M1(CDBITSZ) PUTMSK(RL6,R5) end restore R6 RET PWR2M1: ...do R3:=2**RL3-1 RL5:=RL3; RH5:=0 R3:=1; SDL R3,R5; R3:-1 RET STORE: ...@R3=format of where to store: size; scla if RH6>RH1 then PUTEXT(R3,R5,R1) end else begin if RH1<>'d' then begin if RH1<'4' then begin PUTEXT(R3,'4'*0100+'s',R1) RL3:=CNVTACC(RL7,RH6) end PUTCVFLT(RL3) end else if RH6<>'d' then begin RL3:=CNVTACC(RL7,'4') irst push any prior unpushed entries on accstk) save R8,R9 RH0:=RL3®MSK; R8:=ACCLVL while R8:-1>>=0 do begin RL0:=ACCSTK[R8] if RL0®MSK=RH0 and BITB RL0,PUSHB zero then begin R9:=0 while R9<=R8 do begin RL3:=ACCSTK[R9] lid; remove ^dest. save R6,R7 RH6:=ACCSTK[ACCLVL]->IREG RL3:=ACCSTK[ACCLVL-1]; RL6:=CNVTACC(RL3,B.(SZINT+'0'))->RL7 if CDBITSZ<>(SZINT*8) then begin B.REQREG(B.(SZINT+'0'))->RL3->RL7; PUTLDREG(RL3,RL6) ...above not necessary if 'R' follows R5:=SZ(RL5)<=2 then RL7:|WRD RL3:=RL7 restore R7 RET ACCSZ: ...enter RL3=size char as for DATSZ ...ret. RL3=value for RSZMSK of accstk entry if DATSZ(RL3)<=2 then RL3:=WRD else RL3:=0 RET DATSZ: ...enter RL3=size char '1','2','4','p','f','d','b','s' .ss, incl. offset, poss. ... symbol name or value; poss. supp. info (struct size/bit field info) save R6,R7 RDCDSTR(R3) RH6:=CDSC; RH7:=CDDATTYP ...for efficiency if RH6='i' then begin RL6:=SETACCOP() ...RL6=acc, top 2 items on accstk unpushed  PUTCVINT(RL3) end end RL3:=CNVTACC(RL7,RH6) restore R6,R7 RET BINYOPK: ADMODE:='K'; BINYOP(R3); RET BINARYOP: ADMODE:=0; BINYOP(R3); RET BINYOP: ...enter @R3=binary op code + 2-byte size/type for result + 2-byte ... size/type of 1st operand if BITB RL3,PUSHB zero then begin SETB ACCSTK[R9],PUSHB PUTPUSH(RL3) end R9:+1 end JR PSHPRVX end end PSHPRVX~ restore R8,R9 RET PSHREGS: ...put out push for all unpushed reg. entries on ACCSTK, mark pushed ...(could alPWR2M1(CDBITSZ) PUTMSK(RL7,R5) RL1:=CDBITO; RH1:=0 PUTSHFT(RL7,'2'*0100+'u',R5) B.REQREG(B.(SZINT+'0'))->RL3->RH7 PUTILDV(RL3; RL5:=SZINT; SUBL RR0,RR0) ...also gets passed IREG R5:=PWR2M1(B.(SZINT*8))-PWR2M1(CDBITO+CDBITSZ)+PWR2M1(CDBIT..ret. R3=corres. size RL0:=RL3; R3:=4 if RL0<='2' then begin RL3:=RL0-'0'; RH3:=0 end if RL0='p' or RL0='s' then R3:=SZPOINT if RL0='b' then R3:=SZINT ...could also have SZFLOAT,SZDOUBLE RET ADJTYPSU: ...enter R3='1u','2s','p_','f_',etc; change 'p_XCACCSTK() ...exchange top 2 items on accstk B.SETIREG()->IREG end else RL6:=SETACC() B.DATSZ(RH7)->RL7 RL3:=CNVTACC(RL6,RH7) ...->RL6 ...in case storing smaller part of int RL5:=RL7; LDL RR0,CDVALOFF ...args for PUT..()s below case RH6: of ' (1 down on accstk) + size/type for 2nd ... operand (on top of accstk); if pointer add/sub, size of pointed-to ... object follows; also ADMODE is set to 0 (reg.) or 'K' (const.) save R6..R8 R8:=R3 RH6:=@R8'->CDOP RDTYP1(R8); R8:+2; RDTYP2(R8); R8:+2;so `push' as unit) save R8 R8:=0 while R8<<=ACCLVL do begin RL0:=ACCSTK[R8] if BITB RL0,PUSHB zero then begin SETB RL0,PUSHB; RL0:->ACCSTK[R8] PUTPUSH(RL0) end R8:+1 end restore R8 RET CKFREE: ...ret. Z=1 iff reg.# RL3 is free O) PUTMSK(RH7,R5) ...mask off bit field PUTOR(RL7,RH7,B.(SZINT+'0')) REMOVE(); REMOVE() end PUTSTI(RL3:=RL7; RL5:=SZINT; SUBL RR0,RR0) ...also gets passed IREG REMOVE() restore R6,R7 RET FORCE: ...make sure result in current accum. is in r' to equiv. int., ... 'f_'->'d_' iff same; ret. R3=adjusted 2 chars if RH3='p' then R3:=(SZPOINT+'0')*0100+'u' if RH3='f' then RH3:='d' RET REQREG: PROC ...enter with RL3=size/type char. ("1","2","p",etc) ...get free reg.<>last 2 for accum. ...if ner': PUTSTREGV() 'f': begin ...frame ptr rel. if RH7='s' or RH7='b' then begin B.REQADRREG()->RL3 PUTFLDA(RL3; RL5:=SZPOINT; LDL RR0,CDVALOFF) if RH7='s' then STSTRC2() else STBITF2() ...store struct. or bit field ...if can d RDTYP3(R8); R8:+2 if ADMODE='K' then begin RL6:=SETACC(); RL7:=0FF InhexL(R8) ...->RR2 end else begin RL7:=SETACCOP(); RL6:=ACCSTK[ACCLVL-1] InhexO(R8) ...->RR2, only need if 'p_' op end LDL OPDVAL,RR2 if RH6='+' or RH6='-' then begin (not used or pushed) RL0:=RL3®MSK; R1:=0 while R1<<=ACCLVL do begin RH0:=ACCSTK[R1] if RL0=RH0®MSK and BITB RH0,PUSHB zero then begin RESFLG Z; RET end R1:+1 end R0==R0; RET SETREGSJP: ...set up regs. for jp; if reg. on top of aet. register; @R3=size save R6..R7 RL0:=@R3; RL6:=ACCSTK[ACCLVL] if RL6®MSK<>RETREG then begin B.ACCSZ(RL0)|RETREG->RL3->ACCSTK[ACCLVL]->RL7 PSHPRV(RL3) ...chk if need to push prev. instance of reg. PUTLDREG(RL7,RL6) end restore R6..R7 Rxt one not free, push it (& any prior unpushed accs.) ...put on accstk; ret. as on accstk in RL3 B.ACCSZ(RL3)->RL3 REQREG1(RL3) RET REQREG1: PROC ...enter with RL3=value for RSZMSK of accstk entry ...get free reg.<>last 2 for accum. ...if next one no insert bit field, combine with PUTSTF,etc end else PUTSTF() end 'i': begin ...PUT routines also get passed IREG if RH7='s' or RH7='b' then begin B.REQADRREG()->RL3 PUTILDA(RL3; RL5:=SZPOINT; LDL RR0,CDVALOFF) if RH7= if TYP1='p' then begin R0:=0; R1:=TYPSU3 if TYP2<>'p' then begin R0:=1; R1:=TYPSU2 end PTRADDSUB(RL6,RL7) ...also passes RR0,ADMODE,CDOP,OPDVAL JR BINOPX end if TYP2='p' and TYP3='p' then begin SUBPTRS(RL6,RL7,TYPSU1) ...@ ccstk='begin' reg., make ... sure unpushed, else push all regs. (so diff branches come out same) if R1:=ACCLVL>>=0 and BITB ACCSTK[R1],BEGB not zero then SETACC() else PSHREGS() RET SETACC: ...if top member of accstk=pushed, pop it; ret. RL3=value sa9] if R0:=@R13[TYPE]&TMASK=ARY then begin ...convert array to ptr R1:=@R13[AGGPTR]; @R1[SDPTR]->@R13[AGGPTR] M_REL(R1) @R13[TYPE]&(-TMASK-1)|PTR->@R13[TYPE] end else if R0=FTN then begin ...convert ftn to ^ftn INCREF(@R13[TYPE])ignore float save R6..R8 RL6:=RL3; RH6:=RL0; R7:=R1 ADMD:=ADMODE; LDL RR2,OPDVAL; LDL OPVAL,RR2 PUTCP(RL6,RL5,RH1) ...also passes ADMD,OPVAL if CDOP<>':' then begin RL3:=CNVTACC(RL6,RH6) PUTTCC(RL3,CDOP,RL7) end restore R6..R8 RET .../SEG [ILVL]<>CHAR then WRGTYP() RL6:=@R8' SAVKW(RL6; RH3:=0) INXT2() end INITRBR() ...fake right brace M_REL(R9) end else begin if R3<>(PTR+CHAR) then begin M_REL(R9); WRGTYP() end ...initing ^char: MAKSNUM()->R1->R8 ...R1,R8ve R6 RL3:=ACCSTK[ACCLVL] if BITB RL3,PUSHB not zero then begin RESB RL3,PUSHB; RL3:->ACCSTK[ACCLVL]->RL6 PUTPOP(RL3) RL3:=RL6 end restore R6 RET SETACCOP: ...get top 2 members of accstk unpushed (get another reg. if nec.) ...top member ret->@R13[TYPE] end R8:=@R13[TYPE] if R8&(-BTMASK-1) zero then CVTUP(R8)->R8->@R13[TYPE] ...cnvt char,short->int, float->double ... R0:=@R13[TYPE]; R1:=R0&(-BTMASK-1) ... if R0=CHAR or R0=SHORT then R1:|INT->@R13[TYPE] ... ...cnvt char,shor...tmp ...GETCHSTR: WORD 07F44 07F45 09E08 ...PUTCHSTR: WORD 031E3 00004 07F45 09E08 ...SETUP: PROC ... LDL RR4,CDPTR; R5:-0A; ?"STOP=0.",R5: ... R5:-20; LDAR RR2,GETCHSTR; R1:=6; LDIRB @RR4,@RR2,R1 ... R5:+4 ... LDAR RR2,PUTCHSTR; R1:=8; LDIRB @RR4,@RR2,=label# SVADRVAL(SUBL RR2,RR2; R5:=1; R1:) ...save (ptrsz snum"a"0) INXT2() ...put out addr ref ...(^symtab entry->SYMPTR) PUTSTRTAB(R8,R9) end restore R6..R9 R0==R0; RET PUTSTRTAB~ ...R3=snum for ^to string; R5=^string in membuf ...put R3,'d in RL3 save R6 RH6:=ACCSTK[ACCLVL-1] B.SETACC()->RL3->RL6 if RL3®MSK=RH6®MSK then begin REMOVE() RL3:=REQREG1(RL6&RSZMSK) RL5:=RL6; RL6:=RL3 PUTLDREG(RL3,RL5) end ACCLVL:-1; SETACC(); ACCLVL:+1 RL3:=RL6 restore R6 RET XCACCSTt->int ... if R0=USHORT then R1:|UINT->@R13[TYPE] ... if R0=FLOAT then R1:|DOUBLE->@R13[TYPE] ...cnvt float->double ... R8:=@R13[TYPE] if B.@R13[SCLASS]=REGISTER then begin ALLOREGV(R8) if R3<>-1 then R3:->@R13[LOVAL] else B.AUTO->R1 ... RET .../NONSEG /ZAPALL TMPS /PACKALL  ... rhhhhhh ...load from reg. hhhhhh ... Khhhhhhhh ...immediate ... 2 ..?"STOP=0.",R5: ... R5:-20; LDAR RR2,GETCHSTR; R1:=6; LDIRB @RR4,@RR2,R1 ... R5:+4 ... LDAR RR2,PUTCHSTR; R1:=8; LDIRB @RR4,@RR2,R5 in STRTABN,STRTABP tables, ...R5->AGGPTR field of symtab R0:=R3 if R1:=NSTR>=MAXNSTR then begin Errm(); DEFT 'TOO MANY STRINGS ' end R5:->STRTABP[R1] R0:->STRTABN[R1] NSTR:+1 RET OUTLABD~ := .OUT("lD"OuthexW) ; OUTZP := .OUT("Z"OuthexW) ; OUTSTRK: ...exchange top 2 members of accstk (both must be unpushed) R1:=ACCLVL RL0:=ACCSTK[R1] ACCSTK[R1-1]->ACCSTK[R1] RL0:->ACCSTK[R1-1] RET ...GETSTKOFF: ...ret. R3=stack offset since beg. or last 'end of section' ... R1:=ACCLVL; R0:=0 ... while R1>>=0then begin SET R5,12 ...mark init'n ref. RES R10,ADRFLGB end XLCDADR(LDL RR2,RR8) ...->RR2 INRELOC(R5:) LDL RR8,RR10 until TESTL RR10 zero; end restore R7..R11 RET nd XLCDADR(LDL RR2,RR8) ...->RR2 INRELO@R13[SCLASS] end ...calculate offset on stack ALIGN(R10,R8)->R10 if B.@R13[SCLASS]=REGISTER then begin OUTLDRF_(@R13[LOVAL],R10,R8) ...load reg. from stack end else R10:->@R13[LOVAL] GETSZ(R8,@R13[AGGPTR])->R3; R10:+R3 R9:+1 endG: ...enter with R3=snum for string label, R5=^string in buffer ...send label & put out string in idata area; rel. membuf save R6..R8 R8:=R5->R7 OUTLABD(R3) ...output label repeat RL6:=@R8' OUTDTA(RL6,1) ... if CKOUTON() then OUTDTA(RL6,1) . and BIT ACCSTK[R1],ENDSECB zero do begin ... if BIT ACCSTK[R1],PUSHB not zero then begin ... R0:+2 ... if ACCSTK[R1]&RSZMSK zero then R0:+2 ... end ... R1:-1 ... end ... R3:=R0; RET RDCDSTR: ...@R3=code string (after 'L'/'S'); read info intC(R5:) LDL RR8,RR10 until TESTL RR10 zero; end restore R7..R11 RET LDL RR8,RR10 until TESTL RR10 zero; end restore R7..R11 RET ..R11 RET R11 RET M(LDL RR2,RR8; R5:=SZPOINT); LDL RR10,RR2 R5:=R7 if BIT R10,ADRFLGB not restore R8..R10,R13 R0==R0; RET OUTLDRF_~ ...load reg. number in R3 with @(fp+R5) for type R1 CALL OUTLDRF; RET ALLOREGV: ...if one free, allocate a register variable for type R3 and return ... RH3=reg. type (0=A, 1=B), RL3=number; else R3=-1 save ..not if string in "sizeof" until RL6=0; M_REL(R7) restore R6..R8 R0==R0; RET OUTSTRGS~ ...put out strings pointed to during init'n; make labels & do Zp's save R8 R8:=0 while R8R3 OUTSTRG(R9,STRTABP[R8]) OUTo variables save R8 R8:=R3 B.@R8'->CDDATTYP RL0:=@R8'->CDSC if RL0='g' or RL0='c' then begin InhexW(R8)->CDSYM; R8:+4 end if CDSC='K' then begin InhexL(R8); R8:+8 end else begin SUBL RR2,RR2 if CDSC<>'c' then begin InhexO(R8); R8:+6 end end @ R6..R10 R1:=R3 if R3&TMASK=PTR then R1:=0 if R1&TMASK zero then begin if R1>=UINT then R1:-(UINT-INT) if R1<=DOUBLE and RH6:=TYPRV[R1]<>-1 then begin RL6:=WIDTHRV[R1] ...# of regs needed for type RL7:=ALGNRV[R1]; RH7:=0; R7:-1 ...alignB ...GEN: ADDR Gen ...ZP: ADDR Zp ERR0: ADDR Err0 ... RE: ADDR Re XC: ADDR Xc ...WRE0: ADDR WRe0 ...WRE4: ADDR WRe4 ...WRE8: ADDR WRe8 *ZAPALL TMPS *PACK ALL  0 ...logical table to use for NXTSYM_ (covers bits MACB,TAGMB) ...(make byte if SFLAGS made ZP(R9) R8:+1 end restore R8 R0==R0; RET PARM0: NPARM:=0; RET ADDPARM: ...id for func param is on STACK; enter in symtab & save ^ in PARMTAB if NPARM>=MAXNPARM then begin Errm(); DEFT 'TOO MANY PARAMS' end SYMTYP:=INT; SYMAGG:=0; SYMSC:=AUTO; SUBLDL CDVALOFF,RR2 if CDDATTYP='s' then begin InhexO(R8); LDL CDSTRCSZ,RR2 end if CDDATTYP='b' then begin InhexW(R8)->R3; RH3:->CDBITO; RL3:->CDBITSZ end restore R8 RET RDTYP1: ...enter @R3=2 bytes to read into TYP1 & SU1 RL0:=@R3'->TYP1; B.@R3->SUment needed for type -1 R10:=FSTRV_A; R8:=FSTRV_A+NRV_A; R9:=^RVALLO_A-FSTRV_A if RH6<>0 then begin ...if B-type reg. R10:=FSTRV_B; R8:=FSTRV_B+NRV_B; R9:=^RVALLO_B-FSTRV_B end while R10PARMTAB[NPARM]; NPARM:+1 R0==R0; RET DCLPARM2: ...chk if param & set type,aggptr,storage class of symbol 1; RET RDTYP2: ...enter @R3=2 bytes to read into TYP2 & SU2 RL0:=@R3'->TYP2; B.@R3->SU2; RET RDTYP3: ...enter @R3=2 bytes to read into TYP3 & SU3 RL0:=@R3'->TYP3; B.@R3->SU3; RET PUTAROP: ...enter with with RL3=dest. reg., RL5=source reg. (0FF=>constagin ...if reg. aligned R1:=R9+R10; RL0:=RL6 repeat B.@R1==0; JR NZ,ALORV1 ...chk if reg. allocated R1:+1 until RL0:-1 zero; R1:=R9+R10; RL0:=RL6 repeat B.1->@R1' ...mark allocated until RL0:-1 zero; R3:=R10; RH3:=RH6; JR ALORVXon STACK ... using CURTYP, CURAGG, SCDCL[0] if LKUPNLRe() not zero or B.@R13[SLEVEL]<>1 then NDFERR() CURTYP->@R13[TYPE]; CURAGG->@R13[AGGPTR]; SCDCL[0]->@R13[SCLASS] R0==R0; RET RVALLOI~ ...clear RVALLO_A & RVALLO_B R1:=^RVALLO_A; RH0:=NRV_A+1; RL0:nt) ... R1=size/type/signedness chars (i.e. '2s') ...also have CDOP,ADMODE,OPDVAL ...put out arithmetic operation PUSH R3; ADMD:=ADMODE; LDL RR2,OPDVAL; LDL OPVAL,RR2; POP R3 if RL0:=CDOP='*' then PUTMULT() else if RL0='/' then PUTDIV() else if RL0= end ALORV1~ R10:+1 end end end R3:=-1 ALORVX~ restore R6..R10 RET FUNCBEG: ...init for ftn; also send codegen 'beg of ftn' RVALLOI() ...clear reg. var allocation vectors SCPLVL:=1 R3:=NPARM; RL3->LOCALFLG[1] FRMOFFST:=0 ...c=0 while RH0:-1 not zero do RL0:->@R1' R1:=^RVALLO_B; RH0:=NRV_B+1 while RH0:-1 not zero do RL0:->@R1' RET INCREF: ...change type R3 to type ^ to R3 R0:=R3->R1 if R3&0C000 not zero then TUDEEP() R0:&(-BTMASK-1); SLL R0,2 R3:=R1&BTMASK|R0|PTR RET '%' then PUTMOD() else begin RL1:=RH1 case RL0: of '+': PUTADD() '-': PUTSUB() '|': PUTOR() '&': PUTAND() '^': PUTXOR() '{': PUTSHFTD() '}': PUTSHFTDR() end end RET PUTRELOP: ...enter with RL3=dest reg., RL5=ould later keep max. offset + offset for each level ... so can back up over stuff MAKSNUM()->R3->ENTRSN OUTENTRW(R3) RET OUTENTRW~ := .OUT("E"OuthexW) ; FUNCEND: ...send codegen 'end of ftn' with FRMOFFST & regs used for vars. PUSH R6 ZAPLOCALS()  FIXPARMS: ...go thru PARMTAB: fix up type, storage class, & offset of params save R8..R10,R13 R10:=SZFPRETAD ...offset for next param; initially=fp + ret addr R9:=0 while R9LOCALFLG[1] ...mark have param(s) R13:=PARMTAB[Rsource reg., R1=typsu chars ('2s') ... for operand, RL0=size char for result ...also have CDOP; compare & set int. of dest. reg=1 if true, else=0 ...or modified: CDOP=':'=>do compare & leave orig. value in dest. ...also have ADMODE,OPDVAL ...for now, A ...zaps params SCPLVL:=0 ...not really needed SVHEXW(ENTRSN) while FRMOFFST&(ALSTACK-1) not zero do FRMOFFST:-1 CNTRVALLO(^RVALLO_A,NRV_A)->R3; RL3->RH6 CNTRVALLO(^RVALLO_B,NRV_B)->R3; RH3:=RH6 SVHEXW(R3) SVHEXO(R3:=-FRMOFFST; R2:=0) OUTXRe3() PO_GbagagՒ1a|a|Юa|a|Єa|a|խ_<|ְ+-*/%{}<> [ ] =#&^|n } ` } 9_G^_,`{_ _t ++ --ҡ ** // %% && || ^^ {{ }}ߙ-> d_Km_xp_~_҈. w_KҀ_x҃_~_Ӌҋߕ_|_ __ ҟ_~`ұ._KҨ_~fҺ0 ҽxX_}_~ Һ_}Ll_}h .Ee_<_~f'ԯ'ޞ"Բ"B: ...enter with id on STACK; declare it undef'd label (ignored if ... already def'd) DCLLAB2(B.ULABEL) RET DCLLAB: ...enter with id on STACK; define it as a label DCLLAB2(B.LABEL) SAVlC(); OUTlab() RET DCLLAB2~ ...common stuff for DCLULAB,DCLLAB; ` ^_ aa R(a_R8->R9; R0:=R5+1 while R0:-1 not zero do begin if<ՉӪՋa|0 a|0 _| %% a|La|P_|a|Ua|Xa|a|7_ԞҸsPFua|ra|v_|a|{a|~a| {{ }}Ta|I7ӌsPsբa|Ӟa|ӡ4ӣ4P֊a|,_2_>_J_|hs)_||_h_| *_h\} *)_hPݹ_f_~LΊߺߴ߭ߧߖ{jL`m?4cjadenter with RL3=LABEL or ULABEL PUSH R6 RL3:->SYMSC RL6:=SCPLVL; SCPLVL:=1 SUBL RR2,RR2; LDL SYMVAL,RR2; SYMTYP:=0; SYMAGG:=0 DCLSYM() B.1->LOCALFLG[SCPLVL] ...mark have symbol in this level RL6:->SCPLVL POP R6; R0==R0; RET SETSTRBUF: ...define buH(pC x  Ep \\3 x  E_K_K _K x nn  tt  bb rr  ff p@_H(! x "" \\ `{ p_K Y. _ .8_r1!Q mS_g B.@R8'<>0 then R1:=R8 end R3:=R1-R9 restore R8,R9 RET BLKENTRY: SCPLVL:+1 B.0->LOCALFLG[SCPLVL] RET BLKEXIT: ZAPLOCALS() SCPLVL:-1 R0==R0; RET ZAPLOCALS: ...zap all symbols with current scope level ...if hiding, restore hidden entries PUSH Ra|_ol_H(8YP_ol06 _M2f𡃽 _M2r (S|S|W|W|=a|7a|_oҫ7o| ]|Us4+Na|a|_olA|o|ѯ]a| P_ol  ۡ_it8a|ejw:k>mtknoz?_ xӆ|~I~_GԞӒ^ӓ^ӋPӋ_GԞӟ&ӗVӗ_GԞӫ==ӭ=ӥӳ!=ӵ#ӭgӮ_GԞ<=[Ӿ>=] <>Є_GԞ<<{>>}Гffer in udata region for structure return ...enter with R3=aggptr of struct.; ret. R3=label no. save R8,R9 R8:=R3 ALIGNU(STRT) ...align BNCODE to structure bdy. SAVlB(); MAKSNUM()->R3->R9 OUTlab0(R3) GETSZ(STRT,R8)->R3; R2:=0 LDL RR0,RR2; ADDL RR0 {op {EpC=&| { ((p_GNC { ((p_GN* { ((p_GN { ))C_K_GN { ::_K_k_&_K_KѴ13 if SCPLVL>=MSCPLVL or LOCALFLG[SCPLVL]<>0 then begin RL0:=0 while Nxtsym(RL0:) do begin if BIT SFLAGS[R13],ZAPB zero and B.@R13[SLEVEL]>=SCPLVL then begin if RL0:=@R13[SCLASS]=ULABEL then begin Errm(); DEFT 'UNSATISFIED GOTO ' ֎`|a|ҘM֚_ zo}_Ma|[_|ք ý`| a|ߴa| a߾a_6 oan}0__GRJT_,_,_Gb_GRJF_,_,_Gb_GRJ_Gb_GRJA_ _Gb_GԞ+-Н_GԞ */%  _GԞ-n $~'!"' !(!"_ )ѡ9(/>)2l_g2_g_gD&GޘL_g_g_gܞ_g,BNCODE; LDL BNCODE,RR0 if TESTL RR2 not zero then OUTUSZ() R3:=R9 restore R8,R9 R0==R0; RET ZAPSTATS: ...zap all static symbols save R13 RL0:=0 while Nxtsym(RL0:) do begin if BIT SFLAGS[R13],ZAPB zero then begin RL0:=@R13[SCLASS] if RaCnGwmE_Kž_kaE_Kž_kaC_lint.$char5+float<2doubleD:structLBunionSIlongZPshortaWunsignedj`autoqgexternyoregister end SET SFLAGS[R13],ZAPB if RL0=EXTDEF or RL0=STATIC or RL0=LABEL then begin OUTZP(@R13[SNUM]) ...send zap to codegen end RELAGG(@R13[AGGPTR]) if BIT SFLAGS[R13],HIDINGB not zero then UNHIDE() end RL0:=1 _vĞ_GRlC_ _GbS_GRd_ !_ _Gb_vĞ_ zo}-L}0P״2a|0a| a7a_6J(M_GRF_,_Gb0Q 0_|C 0_|0 0  ՠׁa|a |_gdX_gk*f_g߾__h]_hD_gCԇT_h R_hՃ_g_hԚՒjԠ՘_gՑ_h_g.Զu_h6՘_hՕ_h_K _l_l`_l{ _lL0=STATIC or BITB RL0,STATICB not zero then begin SET SFLAGS[R13],ZAPB if RL0=STATIC then OUTZP(@R13[SNUM]) ...send zap to codegen RELAGG(@R13[AGGPTR]) end end RL0:=1 end restore R13 R0==R0; RET ...********** ...QRULEI߂xtypedefߊ߀staticߒ߈gotoߙߏreturnߡߗsizeofߩߟbreak߰ߦcontinue߹߯if߿ߵelseƞ߼for̞doҞwhileٞswitchcasedefaultenumhexcode end end POP R13; RET UNHIDE~ ...unhide symbol hidden by symbol with entry @R13 ...must chk all symbols on chain & take one with greatest SLEVEL save R6,R12,R13 RL6:=-1; R12:=0 NXTSYM_0(R13) while NXTSYM_() zero do begin if BIT SFLAGS[R13],HIDDEA a |!8a |s_tjn_~שL|L|6_r8a|o` |.a|owĽa |a| aoa|` |n }a|o}_~̕_ zo}L}0P_~̞a|a|_vĞ_a|a|_m6}Њ ,;߻ _h_m_m_mܞ&:_m2,(:;_p 0E,;L;@_w~_hF[*Q_h\_K^c\_hP l(b]r)f: ...declare QRULE; SCPFLG=SC, id on STACK ... INITDCLX() ... B.SCPFLG->SCDCL[0]; CURTYP:=FTN+INT; CURAGG:=0 ... DCLEXTF() ... RET ...********** SVSTDCL: ...save DCLLVL,CURTYP,CURAGG; inc DCLLVL POP R1; PUSH DCLLVL; PUSH CURTYP; PUSH CURAGG; PUSH R1 IN_K_KaC^ J^ ^ ^ ^ ^ ^^T^,^T^L,_& ,_  ߞ"ީ _8Ѻ1_nC+=_.>J-=_27Q*=_60X/=_:)_%=_>"f>>=_Fm<<=_BtNB not zero and RL6<<@R13[SLEVEL] then begin R12:=R13; RL6:=@R13[SLEVEL] end end if R12<>0 then RES SFLAGS[R12],HIDDENB restore R6,R12,R13 RET DCLLOCAL: ...enter with Id on STACK; if SCDCL[0]=STATIC, define symbol in ... UDATA region; if=REGIa| aa|a_6a|_vėa 8a3%i} M} _ h} _ za} UoS}_ za} UoS}.i}VM}V__ za} UoS}a} 03a3}.a} UoS}.Ma}VUoS}Xa} 3a3}bk} a} 3a3}.lj} M} _8 NOT IN LOOPa} 3a3}dy(h})q_hd_hyՎ[`_H"Օ]ՉմՇ_KՋՠ{ՔՖՑզ,՜խ}ա_g_K ծճլեպ=ծҌհ_kĞ հ,ջ;|_z=ճ_&{_zѢ__z }(CDCLLVL(); RET RESSTDCL: ...restore ILVL,CURTYP,CURAGG; preserve Z-flag POP R1; POP CURAGG; POP CURTYP; POP DCLLVL; JP @R1 SETABSTYP: ...set ABSTYP,ABSAGG; also mark ABSAGG for release; ret Z=1 ABSTYP:=CURTYP; R0:=CURAGG->ABSAGG if R0<>0 and NABSAGG&&jBIZ_j_rH_^_f_STER, see if can allocate reg. var, else ... change to AUTO; if=AUTO, get & define stack offset, update FRMOFFST ...also have CURTYP,CURAGG; chk some types if SCPLVLLOCALFLG[SCPLVL] RL0:=SCDCL[0] if CURTYP&TMASK=FTN then begin ...iъL} a} 3a3}.ѕM} L} M}V_ zo}Ta}TћM}Na}R_vċa 8ao}Pa`o}N a}P_{o}R_nh_a|a}Naa|a}N7a}Na}P_~M}Na}P!3 _M2"_M2׽a}R_MgsѦ_S(G@DY;M_C_USDABAGG[NABSAGG]; NABSAGG:+1 end R0==R0; RET SVSZABTYP: ...save size of type ABSTYP,ABSAGG GETSZ(ABSTYP,ABSAGG)->R3; SAVKW(R3); RET RELABAGG: ...release any used ABSAGG buffers not yet rel'd while NABSAGG<>0 do begin RErP_x_b_rW_ ==_Z!=_^_rh _ޞ#<=_R*>=_V 1<_J7>_N_r߇2_D<<_BK>>_F_rߖG_[+_.a-_2_rߥ\_\q*_f static ftn, make extern if RL0<>STATIC and RL0<>AUTO then WRGTYP() B.EXTERN->SCDCL[0]; DCLEXT() RET end if RL0=STATIC then begin DCLEXTU(); RET end ...may want to delay till end of func.^ if RL0=REGISTER then begin if R3:=ALLOREGV(CURTYP_~_R3; SAVKW(R3); RET RELABAGG: ...release any used ABSAGG buffers not yet rel'd while NABSAGG<>0 do begin RE6 w/_:}%_>_r߻x_ڊмеЭЦЕxgXѷ&߳_++߼_0--_6-_*~'_PP)<>-1 then begin R2:=0; DCLSYM0(); RET end B.AUTO->SCDCL[0] end ...calculate offset on stack PUSH R8 GETSZ(CURTYP,CURAGG)->R1 R8:=FRMOFFST-R1 while ALIGN(R8,CURTYP)<>R8 do R8:-1 ...assumes frame ptr is suitably aligned R8:->FRMOFFST asҎas_vġqaw_6wk}V(ZC:Ӻ_M2_=_Һ_vĕ_ &L}o }5aa_~̞_ڔ*_a|0  0_|a | 0aa|_|8_ol V| a|o}` |n }_~̕_a|0__uf_u^}_n _{ : ;;_g׵_gҭפ_gҵ״_gҸ"$_g__p@_*S5 ߹2G,=N;BR;__hH_KX]V_hPQf( _ߓm)a_hd3 P_ol9P_ol070XFHVӇѨ_GRD_,_Gb_GRR_GbԳԵa|a |Ԡ_|  _K3 8a|aɕ`|   r i_8 NOT LVAL _GRS!/_t_8_Ğ++_b--_h*X_x'_~_~ ).'4(_{_~.0ӵ'5D)8߳_^__@U(K_j_c)Rg[ _nQ_n]b_FtR2:=0FFFF; R3:=R8 DCLSYM0() POP R8; RET DCLEXTNF: ...declare extern function returning int; id on STACK RL3:=SCPLVL; PUSH R3; SCPLVL:=0 SUBL RR2,RR2; LDL SYMVAL,RR2; SYMTYP:=FTN+INT; SYMAGG:=0; SYMSC:=EXTERN DCLSYM() POP R3; RL3->SCPLVL RET DCLULA|a|a|5T|a|_8Y0   0_|8a_ol1_ &aa!5_ __I>`   a0  ИC_I>`   a0 0ЮC_I>a0  ` J_I>a0  0B v*l_h\~(&toׄ)x5y׎=_p"׆_pH_p_q~_qץ{ _pם_q׮}ע_uץ׺,ԋ&׳_K׼_׿_K___w(,_K_w._yX_w_y___g__gӞ_gӝB/g7bЊ]Lߊ!^`:!_ ERROR TOTAL=_ P=!< XҤ*PL Y !Ё!g5d]߸_B C @@@@@@@@@@@@@@@@@@@@@@@@@@C @@@@@@@@@@@@@@@@@@@@@@@@@@D @@@@@@@@@@@@@@@@@@@@@@@@@@D @@@@@@@@@@@@@@@@@@@@@@@@@@E @@@@@@@@@@@@@@@@@@@@@@@@@@E @@@@@@@@@@@@@@@@@@@@@@@@@@F @@@@@@@@@@@@@@@@@@@@@@@@@@F @@@@@@@@@@@@@@@@@@@@@@@@@@G @@@@@@@@@@@@@@@@@@@@@@@@@@G @@@@@@@@@@@@@@@@@@@@@@@@@@H @@@@@@@@@@@@@@@@@@@@@@@@@@H @@@@@@@@@@@@@@@@@@@@@@@@@@I @@@@@@@@@@@@@@@@@@@@@@@@@@I @@@@@@@@@@@@@@@@@@@@@@@@@@J @@@@@@@@@@@@@@@@@@@@@@@@@@J @@@@@@@@@@@@@@@@@@@@@@@@@@K @@@@@@@@@@@@@@@@@@@@@@@@@@K @@@@@@@@@@@@@@@@@@@@@@@@@@L @@@@@@@@@@@@@@@@@@@@@@@@@@L @@@@@@@@@@@@@@@@@@@@@@@@@@